PSLine2000Documentation/Forms/Copy of Process Sheet.md

Copy of Process Sheet

---

Record Source

• Queries/UniversalQ

Controls

Control Name	Reference
Field113	MetalType (from Queries/UniversalQ)
Field113 (Row Source)	Tables/metalQ1;
DatasheetFlag (Row Source)
Field325	Warehouse (from Queries/UniversalQ)
Field325 (Row Source)
BlankSize	BlankSize (from Queries/UniversalQ)
PartSize	PartSize (from Queries/UniversalQ)
GrossWt	GrossWt (from Queries/UniversalQ)
ActualWt	ActualWt (from Queries/UniversalQ)
Utilization	Utilization (from Queries/UniversalQ)
SheetSize	SheetSize (from Queries/UniversalQ)
GrainDir	GrainDir (from Queries/UniversalQ)
GrainDir (Row Source)
BlocksPerSheet	BlocksPerSheet (from Queries/UniversalQ)
BlanksPerBlock	BlanksPerBlock (from Queries/UniversalQ)
PartsPerSheet	PartsPerSheet (from Queries/UniversalQ)
ActualPartHeight	ActualPartHeight (from Queries/UniversalQ)
PartCost	PartCost (from Queries/UniversalQ)
Field238	PartsPerBlank (from Queries/UniversalQ)
PartNumber	PartNumber (from Queries/UniversalQ)
PartName	PartName (from Queries/UniversalQ)
IssueNumber	IssueNumber (from Queries/UniversalQ)
IssueDate	IssueDate (from Queries/UniversalQ)
PreviousIssue	PreviousIssue (from Queries/UniversalQ)
PreviousDate	PreviousDate (from Queries/UniversalQ)
Programmer	Programmer (from Queries/UniversalQ)
PrintSize	PrintSize (from Queries/UniversalQ)
History	History (from Queries/UniversalQ)
MetalType	MetalType (from Queries/UniversalQ)
MetalType (Row Source)	Tables/[metalQ1];
FirstDim	FirstDim (from Queries/UniversalQ)
SecDim	SecDim (from Queries/UniversalQ)
BotTrimCut	BotTrimCut (from Queries/UniversalQ)
TopTrimCut	TopTrimCut (from Queries/UniversalQ)
CutType	CutType (from Queries/UniversalQ)
CutType (Row Source)
Deburr	Deburr (from Queries/UniversalQ)
Deburr (Row Source)
PartWidth	PartWidth (from Queries/UniversalQ)
ActualPartWidth	ActualPartWidth (from Queries/UniversalQ)
PartsPerBlank	PartsPerBlank (from Queries/UniversalQ)
PressBrake	PressBrake (from Queries/UniversalQ)
PressBrake (Row Source)
EntPartHeight	PartHeight (from Queries/UniversalQ)
Field240	CellDeburrTypes (from Queries/UniversalQ)
Field240 (Row Source)
SavedProcesses (Row Source)	Tables/[QWorkCenters];
AddnlDeburrInches	AddnlDeburrInches (from Queries/UniversalQ)
Reason	Reason (from Queries/UniversalQ)
PunchPressOption	PunchOption (from Queries/UniversalQ)
PunchCount	PunchPartsPerStrip (from Queries/UniversalQ)
PunchDie	PunchNumber (from Queries/UniversalQ)
PunchDie (Row Source)	Tables/punchpressQ1;
GrainShearChk	GrainShear (from Queries/UniversalQ)
PunchStd	PunchStd (from Queries/UniversalQ)
PhantomNumber	PhantomNumber (from Queries/UniversalQ)
Gr3	GrainNone (from Queries/UniversalQ)
PaperLaserFlag	PaperLaserFlag (from Queries/UniversalQ)
Pems	PemPress (from Queries/UniversalQ)
PemBefore	PemBefore (from Queries/UniversalQ)
STSCode	STSCode (from Queries/UniversalQ)
chkRotateBlank	GrainShear (from Queries/UniversalQ)

VBA Code

Option Compare Database   'Use database order for string comparisons
Dim dwncntL%, dwncntT%, dwncnt%, ToyClick%, ToyCaption%, Toys$(10)


Private Sub addPr_Click()
    NewPartName_Parm$ = "NEW"
    Call AddPartButton
    
End Sub

Private Sub Button184_Click()
   Call Add_Additional_Process
End Sub

Private Sub Button190_Click()
On Error GoTo Err_Button190_Click
    DoCmd.Quit

Exit_Button190_Click:
    Exit Sub

Err_Button190_Click:
    MsgBox Error$
    Resume Exit_Button190_Click
    
End Sub

Private Sub Button193_Click()
   NewPartName_Parm$ = Me!PartNumber
   Call LogFile(currform!PartNumber, "Save As New Part")
   Call AddPartButton
   
End Sub

Private Sub Button194_Click()
On Error GoTo Err_Button194_Click

    Dim DocName As String
    Dim MyForm As Form

    DocName = PrimaryScreen$
    Set MyForm = Screen.ActiveForm
    DoCmd.SelectObject A_FORM, DocName, True
    DoCmd.PrintOut
    DoCmd.SelectObject A_FORM, MyForm.name, False

Exit_Button194_Click:
    Exit Sub

Err_Button194_Click:
    MsgBox Error$
    Resume Exit_Button194_Click
End Sub

Private Sub Button196_Click()
On Error GoTo Err_Button196_Click
    If currform![CalculationStatus] <> 0 Then
       M$ = "Unable to Print Report." + Chr$(13) + "Calculation Status Of Part in Error."
       MsgBox M$
       Exit Sub
    End If
    Refresh
   If Left$(Initforms$, 2) = "14" Then
    DocName = "Process Sheet Print 14"
    DoCmd.OpenReport DocName, A_PRINTALL, "Q1-14" + Chr$(34)
   Else
    DocName = "Process Sheet Print"
    DoCmd.OpenReport DocName, A_PRINTALL, "Q1"
   End If
Exit_Button196_Click:
    Exit Sub

Err_Button196_Click:
    MsgBox Error$
    Resume Exit_Button196_Click
    
End Sub

Private Sub Button200_Click()
   Dim MainDB As Database, MainSet As Recordset
   Dim MachNamesDB As Database, MachNamesSet As Recordset
   Dim MachQDB As Database, MachQSet As Recordset
   
   Set MainDB = DBEngine.Workspaces(0).Databases(0)
   Set MachNamesDB = DBEngine.Workspaces(0).Databases(0)
   Set MachQDB = DBEngine.Workspaces(0).Databases(0)

   
   Set MachNamesSet = MachNamesDB.OpenRecordset("MachineNames", DB_OPEN_TABLE)   ' Create dynaset.
   Set MachQSet = MachQDB.OpenRecordset("Machines", DB_OPEN_TABLE)   ' Create dynaset.
   Set MainSet = MainDB.OpenRecordset("Process", DB_OPEN_TABLE)   ' Create dynaset.
   
'   Set MachNamesSet = StMachNamesSet
'   Set MachQSet = StMachQSet
'   Set MainSet = StMainSet
   
   PartN$ = Me![PartNumber]
   MainSet.Index = "PrimaryKey"
   MachQSet.Index = "PartNumber"
   MachNamesSet.MoveFirst
         
         
   While Not (MachNamesSet.EOF)
      A$ = MachNamesSet!MachineName
      GoSub search
      If Not (fnd) Then
         MachQSet.AddNew
         MachQSet!MachineName = A$
         MachQSet!Tool = "***"
         MachQSet!PartNumber = PartN$
         MachQSet.Update
      End If
      MachNamesSet.MoveNext
   Wend
   Refresh
   
Exit Sub
   
search:
   MachQSet.MoveFirst
   MachQSet.Seek "=", PartN$, A$
   If MachQSet.NoMatch Then
      fnd = False
   Else
      fnd = True
   End If
Return
End Sub

Private Sub Button244_Click()
On Error GoTo Err_Button224_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DoCmd.Hourglass True
    
    DocName = "Data Sheet Select"
    DoCmd.OpenForm DocName, , , LinkCriteria
    DoCmd.FindRecord Me![PartNumber]
    DoCmd.SelectObject A_FORM, PrimaryScreen$
    DoCmd.Close

Exit_Button224_Click:
    DoCmd.Hourglass False
    Exit Sub

Err_Button224_Click:
    MsgBox Error$
    Resume Exit_Button224_Click
    

End Sub

Private Sub Button246_Click()
    Call HistoryR
    Programmer.SetFocus
End Sub

Private Sub Button247_Click()
   Dim DocName As String
   DocName = "YESORNO"
   YesOrNoStr$ = "delete this part"
   DoCmd.OpenForm DocName
   Do Until YESORNO% > 0
     DoEvents
   Loop
   DoCmd.Close A_FORM, DocName
   If YESORNO% <> 1 Then
      Exit Sub
   End If
   Call LogFile(currform!PartNumber, "Delete Part")
   Call Delete_Part
   
End Sub

Private Sub Button248_Click()
   Call Edit_The_Shear_Files
End Sub

Private Sub Button249_Click()
   Call Find_By_PartNumber
End Sub

Private Sub Button288_Click()
   PN$ = currform![PartNumber]
   thispn$ = " "
'   DoCmd GoToRecord , , A_FIRST
   Do
      Call Calculate_Button
'      On Error GoTo button288_error
           
      DoCmd.GoToRecord , , acNext
      
      On Error GoTo 0
      nextpn$ = currform![PartNumber]
      If thispn$ = nextpn$ Then
        'Exit Do
      End If
      thispn$ = nextpn$
   Loop
button288_last:
   Call GOTOPARTNUMBER(PN$, PrimaryScreen$)
   Call Button291_Click
Exit Sub

button288_error:
   Resume button288_last

End Sub

Private Sub Button289_Click()
End Sub

Private Sub Button290_Click()
   PN$ = currform![PartNumber]
   thispn$ = " "
   DoCmd.GoToRecord , , A_FIRST
   Do

      Refresh
      DocName = "Process Sheet Print"
      DoCmd.OpenReport DocName, A_PRINTALL, "Q1" + Chr$(34)
      
      On Error GoTo button290_error
      DoCmd.GoToRecord , , A_NEXT
      On Error GoTo 0
      nextpn$ = currform![PartNumber]
      If thispn$ = nextpn$ Then
         Exit Do
      End If
      thispn$ = nextpn$
   Loop
button290_last:
   Call GOTOPARTNUMBER(PN$, PrimaryScreen$)
   Call Button291_Click
Exit Sub

button290_error:
   Resume button290_last


End Sub

Private Sub Button291_Click()
   If Button291.Width = Int(0.5563 * 1440) Then
      Button291.Left = 0.0521 * 1440
      Button291.Width = 1.7021 * 1440
      Button291.Caption = "DO ALL"
   Else
      Button291.Left = 1.1979 * 1440
      Button291.Width = 0.5563 * 1440
      Button291.Caption = "Do All Saftey"
   End If

End Sub

Private Sub Button294_Click()
   PN$ = currform!PartNumber
   Phn$ = itsaNull$(currform!PhantomNumber)
   If PN$ <> Phn$ Then
      If Phn$ <> "" Then
         Call GOTOPARTNUMBER(Phn$, PrimaryScreen$)
      End If
   End If
End Sub

Private Sub Button309_Click()
On Error GoTo Err_Button309_Click
    If currform![CalculationStatus] <> 0 Then
       M$ = "Unable to Print Report." + Chr$(13) + "Calculation Status Of Part in Error."
       MsgBox M$
       Exit Sub
    End If
    Refresh
    DocName = "Process Sheet Print"
    DoCmd.OpenReport DocName, A_PREVIEW, "Q1" + Chr$(34)
Exit_Button309_Click:
    Exit Sub

Err_Button309_Click:
    MsgBox Error$
    Resume Exit_Button309_Click
    

End Sub

Private Sub Button322_Click()
   Button322.Caption = "Processing"
   DoCmd.Hourglass True
   Call diskout
   Call UpdateGWs
   DoCmd.Hourglass False
   Button322.Caption = "Create Disk Output"
   Call LogFile(currform!PartNumber, "Create Disk Output")
   
End Sub

Private Sub Button327_Click()
   DoCmd.Hourglass True
   p$ = currform.PartNumber
   If PaperLaserFlag Then PaperFlag$ = "1" Else PaperFlag$ = "0"
   Call LaserTapeGenerate(p$, PaperFlag$, rst!)
   'If Checkupload = True Then
   'Call buttUpload_Click
   'End If
   DoCmd.Hourglass False
   Refresh
End Sub

Private Sub buttUpload_Click()
On Error GoTo Err_buttUpload_Click

    Dim x As Integer
    Dim AppName As String

    AppName = Directory$ & "UPLOADER.BAT"
    x = Shell(AppName, 1)

Exit_buttUpload_Click:
    Exit Sub

Err_buttUpload_Click:
    'MsgBox Error$
    Resume Exit_buttUpload_Click
    
End Sub

Private Sub CalcCNCtape_Click()
   DoCmd.Hourglass True
   Call MoveFilesToPrefixLocation
   Call Button200_Click
   p$ = currform.PartNumber
   Call CalcCNCRunTimes(p$)
   Call Button327_Click    'Laser Fun
   
   If Checkupload = True Then
      Call buttUpload_Click
   End If
   DoCmd.Hourglass False
   Refresh
    Call LogFile(currform!PartNumber, "Get Standard Machines")
   
End Sub

Private Sub MoveFilesToPrefixLocation()
'PartN$ = "2327979D"
PartN$ = currform![PartNumber]
Dim Prefix As String
Prefix = Left(PartN$, 3)
If UCase(Left(PartN$, 1)) = "Z" Then Prefix = "Z"
If UCase(Left(PartN$, 1)) = "X" Then Prefix = "X"
Dim DestinationFolder As String
Dim SourcePath As String
Dim FilesToDelete As String
Dim strFileName As String
Dim strFolder As String: strFolder = "S:\FL3030\"
Dim strFileSpec As String: strFileSpec = strFolder & "*.*"
DestinationFolder = strFolder & Prefix
CreateDir (DestinationFolder)
strFileName = Dir(strFileSpec)
FilesToDelete = ""
Do While Len(strFileName) > 0
Debug.Print strFileName
    If InStr(1, strFileName, PartN$, vbTextCompare) Then
        SourcePath = strFolder & strFileName
        FileCopy SourcePath, DestinationFolder & "\" & strFileName
        FilesToDelete = FilesToDelete & SourcePath & vbCrLf
    End If
    strFileName = Dir
Loop

Dim MyFile() As String
MyFile = Split(FilesToDelete, vbCrLf)
For Each XFile In MyFile
    If XFile <> "" Then
        Kill (XFile)
    End If
Next

Debug.Print FilesToDelete
End Sub

Private Sub Calculate_Click()
   Dim DocName As String
   Call Calculate_Button
   Call LogFile(currform!PartNumber, "Calculate")
End Sub

Private Sub cmd300Series_Click()
   DoCmd.Hourglass True
   Set XrefQDB = DBEngine.Workspaces(0).Databases(0)
   Set XrefQSet = XrefQDB.OpenRecordset("RMSFILES#_EGSSP1A0", DB_OPEN_DYNASET)  ' Create dynaset.
   XrefQSet.MoveFirst
   PartN$ = currform![PartNumber]
   xPN$ = Left(currform![PartNumber], 7)
   newnum$ = ""
   Do Until XrefQSet.EOF
      If (Trim(XrefQSet!CURPN) = xPN$) Then
         newnum$ = Trim(XrefQSet!NEWPN)
         If newnum$ <> "" Then
            newnum$ = newnum$ + Right(Trim(PartN$), 1)
         End If
         Exit Do
      End If
      XrefQSet.MoveNext
   Loop
   If newnum$ <> "" Then
      Curprt$ = Directory$ + "VLT1\" + revext(PartN$)
      If Exists(Curprt$) Then
         NewPrt$ = Directory$ + "VLT1\" + revext(newnum$)
         Open Curprt$ For Input As #1
         Open NewPrt$ For Output As #2
         While Not EOF(1)
            Line Input #1, A$
            If InStr(A$, PartN$) <> 0 Then
               A$ = ReplaceStr(A$, PartN$, newnum$)
            End If
            Print #2, A$
         Wend
         Close #1, #2
      End If
      Curprt$ = Directory$ + "VT2\" + revext(PartN$)
      If Exists(Curprt$) Then
         NewPrt$ = Directory$ + "VT2\" + revext(newnum$)
         Open Curprt$ For Input As #1
         Open NewPrt$ For Output As #2
         While Not EOF(1)
            Line Input #1, A$
            If InStr(A$, PartN$) <> 0 Then
               A$ = ReplaceStr(A$, PartN$, newnum$)
            End If
            Print #2, A$
         Wend
         Close #1, #2
      End If
   End If
   DoCmd.Hourglass False
   
End Sub
Function revext(p$)
   revext = Left(p$, 7) + "." + Right(p$, 1)
End Function
Public Function ReplaceStr$(source$, Target$, Replc$)
'
'Replaces each instance of the string Target$ with the string Replc$ in the string Source$
'
   NS$ = source$
   FromPl% = 1
   While InStr(Mid$(UCase$(NS$), FromPl%), UCase$(Target$)) <> 0
      A% = InStr(Mid$(UCase$(NS$), FromPl%), UCase$(Target$))
      A% = A% + FromPl% - 1
      NS$ = Left$(NS$, A% - 1) + Replc$ + Mid$(NS$, A% + Len(Target$))
      FromPl% = A% + Len(Replc$)
   Wend
   ReplaceStr$ = NS$
End Function

Private Sub cmdDeleteFileFromTrumpfs_Click()
On Error Resume Next
Dim x As String
x = "S:\Garrett\Trumpf_Clean_Machine\TrumpfReports\" & PartNumber
If Not Exists(x) Then
    Open x For Output As #2
    Print #2, Now()
    Close #2
End If
End Sub

Private Sub cmdTricks_Click()
On Error GoTo Err_cmdTricks_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DocName = "Tricks"
    DoCmd.OpenForm DocName, , , LinkCriteria

Exit_cmdTricks_Click:
    Exit Sub

Err_cmdTricks_Click:
    MsgBox Error$
    Resume Exit_cmdTricks_Click
    
End Sub

Private Sub Command357_Click()
   DoCmd.Hourglass True
   Call UpdateGWs
   DoCmd.Hourglass False
End Sub
Sub UpdateGWs()

   Dim MainDB As Database, MainSet As Recordset
   Dim Main2DB As Database, Main2Set As Recordset
   
   Set MainDB = DBEngine.Workspaces(0).Databases(0)
   
'   currform.Refresh
   PN$ = currform!PartNumber
   'PN$ = Left$(PN$, 7)
   PN$ = Mid(PN$, 1, Len(PN$) - 1)
   wh$ = currform!Warehouse
   Set Main2Set = MainDB.OpenRecordset("RMSFILES#_MFWKP795", DB_OPEN_DYNASET)  ' Create dynaset.
   
   On Error Resume Next
   Main2Set.MoveFirst
   On Error GoTo 0
   Users$ = Trim(myNTUserName$)

   Do
      If Not (Main2Set.EOF) Then
         If Trim$(Main2Set![UID]) = Users$ Then
            Main2Set.Delete
         End If
         DoEvents
      Else
         DoEvents
         Exit Do
      End If
      Main2Set.MoveNext
   Loop
      
      Gws$ = Format(itsaNull$(currform!GrossWt), "#.000")
      aws$ = Format(itsaNull$(currform!ActualWt), "#.000")
      matl$ = currform!Field113.Column(2)
      pps$ = currform!PartsPerSheet
      If currform!PartsPerBlank.Visible = True Then
         ppb$ = currform!PartsPerBlank
      Else
         ppb$ = currform!BlanksPerBlock
      End If
      Main2Set.AddNew
      Main2Set![UID] = Users$
      Main2Set!PRDNO = PN$
      Main2Set!KBLWH = wh$
      Main2Set!netwt = aws$
      Main2Set!GRSwt = Gws$
      Main2Set![MATL#] = matl$
      Main2Set!SSIZE3 = pps$
      Main2Set!BSIZE3 = ppb$
      Main2Set.Update
   Main2Set.Close
   MainDB.Close
   'ActiveXCtl358.CommandString = "Call PGM(MFR795) PARM('" + Users$ + "')"
'currform! .DoClick
End Sub

Private Sub CutType_Click()
   Call CutTypeFormSettings
End Sub

Private Sub FindMakeButton_Click()
   Call Find_By_MakeNumber
End Sub

Private Sub FindPhantom_Click()
    Call Find_By_PartNumber
End Sub

Private Sub Form_Current()
 '
 ' Code to indicate record is locked (Requires a text object called LOCKEDRECORD
 '
 '
   A$ = itsaNull$(Me!IssueNumber)
   If A$ = "" Then A$ = " "
   l = 0
   On Error GoTo BadRecord
   Me!IssueNumber = A$
   If l <> 0 Then
      LockedRecord.Visible = True
   Else
      LockedRecord.Visible = False
   End If
   On Error GoTo 0
   lblXrefMessage.Visible = False
   cmd300Series.Visible = False
   Call CrossRef
   Call CutTypeFormSettings
   Call PBFormView
   Call PemPressView
   GrainFromRec
   lblDedicatedCell.Caption = GetLineFromDedicated(Me!PartNumber)
   Call ErrorMessages
   Exit Sub
BadRecord:
   l = 1
Resume Next

End Sub

Private Function GetLineFromDedicated(Pnnum As String) As String
   Dim dbs As DAO.Database
   Dim rst As DAO.Recordset
   Dim i As Integer
   Dim wrk, sql, Mach As String
   wrk = Trim(Pnnum)
   
   sql = "SELECT ProductMaster.PRDNO, DedicatedCells.Active, DedicatedCells.AlphaCode, DedicatedCells.Machine"
   sql = sql + " FROM ProductMaster INNER JOIN DedicatedCells ON ProductMaster.PALPH = DedicatedCells.AlphaCode"
   sql = sql + " WHERE (((ProductMaster.PRDNO)='" + Left(wrk, 7) + "') AND ((DedicatedCells.Active)=True));"
   
   Set dbs = CurrentDb
   Set rst = dbs.OpenRecordset(sql)
  
   Mach = ""
   If rst.recordCount > 0 Then
       rst.MoveFirst
       Mach = rst!Machine
   End If
   
   GetLineFromDedicated = Mach
End Function

Private Sub Form_Load()
   Set currform = Me
   On Error GoTo FL_die
   dwncntT% = 1
   dwncntL% = 1
   TextCalcErr.Visible = False
   TextCalcErr.Top = 2.58 * 1440
   
   If Left$(Initforms$, 2) = "14" Then
      DocName$ = "14" + Chr$(34) + " Process Sheet"
   Else
      DocName$ = "Process Sheet"
   End If
   PrimaryScreen$ = DocName$

   On Error GoTo FL_die
   DoCmd.GoToControl "PartName"
   DoCmd.GoToControl "PartNumber"
   On Error GoTo 0
ToyDepartment:
   On Error Resume Next
   Toys$(0) = "DO NOT PRESS THIS BUTTON"
   Toys$(1) = "HEY, I told you not to do that!"
   Toys$(2) = "What Kinda Moron are you?"
   Toys$(3) = "I'm Warning you...."
   Toys$(4) = "If you think this is a joke..."
   Toys$(5) = "OK, Look... if you do that again..."
   Toys$(6) = "What's a matter buddy can't you read?"
   Toys$(7) = "I won't be held responsible for what happens next!"
   Toys$(8) = "If you do that again... You Will Be sorry!"
   Toys$(9) = "I tried to warn you!"
   Toys$(10) = "That was fun but . . . DO NOT PRESS THIS BUTTON"
   Killer.Top = 0
   Killer.Left = 0
   Killer.Height = 9285
   Killer.Width = 10785


Exit Sub

FL_die:
   If Err = 2109 Then
      End
   End If
   Resume Next
 

  
End Sub

Private Sub Form_Timer()
   If dwncnt% = 1 Then
      Steps% = 100

      Toy.Visible = True
      Toy.Top = Toy.Top + dwncntT% * Steps%
      Toy.Left = Toy.Left + dwncntL% * Steps%
      If ((Toy.Top + dwncntT% * Steps%) > 7000) Then
         dwncntT% = -1
         Toy.Top = 7000
      End If
      If ((Toy.Top + dwncntT% * Steps%) < 0) Then
         Toy.Top = 0
         dwncntT% = 1
      End If
      If ((Toy.Left + dwncntL% * Steps%) > 7000) Then
         Toy.Left = 7000
         dwncntL% = -1
      End If
      If ((Toy.Left + dwncntL% * Steps%) < 0) Then
         Toy.Left = 0
         dwncntL% = 1
      End If

   End If
   If ToyClick% = 1 Then
      ToyClick% = 0
      ToyCaption% = ToyCaption% + 1
      If ToyCaption% > 10 Then
         ToyCaption% = 0
         dwncnt% = 0
         Toy.FontSize = 8
         Toy.Height = 840
         Toy.Width = 870
         Toy.Top = 945
         Toy.Left = 9465
      End If

      If ToyCaption% = 9 Then
         Killer.Visible = True
      Else
         Killer.Visible = False
      End If
      Toy.Caption = Toys$(ToyCaption%)
   End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DoCmd.Close acForm, "Filtered Parts"
End Sub

Private Sub GrainShearChk_Click()
   Call CutTypeFormSettings
End Sub

Private Sub GrDirOpt_Click()
   NewGrain
End Sub


Private Sub Info_Click()
Call gatherinfo
    Button246.SetFocus
End Sub

Private Sub MetalType_Click()
   Call CutTypeFormSettings
End Sub

Private Sub PartNumber_GotFocus()
' If itsaNull(PartName) = "" Then
'Info.Visible = True
'Else
'Info.Visible = False
'End If
End Sub

Private Sub Pems_AfterUpdate()
   Call PemPressView
End Sub

Private Sub PressBrake_Click()
  Call PBFormView
End Sub

Private Sub PressBrake_GotFocus()
  Call PBFormView
End Sub

Private Sub PressBrakeSubForm_Enter()
    Text234.Visible = True
    Text237.Visible = True
End Sub

Private Sub PressBrakeSubForm_Exit(Cancel As Integer)
    Text234.Visible = False
    Text237.Visible = False
End Sub

Private Sub Programmer_LostFocus()
'  a$ = Me![Programmer]
'
'       If a$ = "SG" Or a$ = "CB" Or a$ = "ST" Or a$ = "KL" Then
'       Checkupload = True
'       Else
'       Checkupload = False
'       End If
End Sub

Private Sub PunchDie_AfterUpdate()
      If (PunchDie = "!NONE!") Or (Trim$(PunchDie) = "") Then
         PunchPressOption.Visible = False
         PunchCount.Visible = False
         PunchStd.Visible = False
      Else
         PunchPressOption.Visible = True
         If CutType = "Single" Then
            PunchCount.Visible = False
            PunchStd.Visible = True
         Else
            PunchCount.Visible = True
            PunchStd.Visible = True
         End If
      End If
End Sub

Private Sub PunchPressOption_AfterUpdate()
   If (CutType <> "Single") Then
      If PunchPressOption = 2 Then
         PunchCount.Visible = True
      Else
         PunchCount.Visible = True
      End If
   Else
      PunchCount.Visible = False
   End If
   PunchStd.Visible = True

End Sub

Private Sub Text191_DblClick(Cancel As Integer)
DoCmd.OpenQuery "LogFileQ", acViewNormal, acReadOnly
End Sub

Private Sub Toy_Click()
   If ToyCaption% = 0 Then
      Toy.FontSize = 18
      Toy.Height = 1305
      Toy.Width = 3570
      dwncnt% = 1
   End If
   ToyClick% = 1
End Sub

Sub gatherinfo()
On Error Resume Next

Dim rs As DAO.Recordset
Dim db As Database
Dim strSQL As String

Set db = CurrentDb()
 

Part = Mid(PartNumber, 1, Len(PartNumber) - 1)

strSQL = "select * from ProductMaster WHERE PRDNO = '" & Part & "'"

Set rs = db.OpenRecordset(strSQL)

'Debug.Print rs![PRDNO] & " | " & rs![DESCP]
PartName = Trim(rs![DESCP])

 End Sub

What it does

VBA Code Description

This VBA code is a set of event handlers for an Access database application. It appears to be part of a tool for managing parts and related data. The code handles various button clicks, form interactions, and error handling.

Button Click Events

addPr_Click

• Calls the AddPartButton subroutine when clicked.
• Sets the NewPartName_Parm$ variable to "NEW".

Button184_Click

• Calls the Add_Additional_Process subroutine when clicked.

Button190_Click

• Quits the application when clicked, with error handling for unexpected errors.
• Displays an error message and continues execution.

Button193_Click

• Logs a new part to the database by calling the LogFile subroutine.
• Calls the AddPartButton subroutine.

Button194_Click

• Prints the current form's data when clicked, with error handling for unexpected errors.
• Opens the "Data Sheet Select" form and searches for a record with the same part number.

Button196_Click

• Checks if calculation status is valid before printing a report.
• Refreshes the application if necessary.
• Opens the corresponding report ("Process Sheet Print 14" or "Process Sheet Print") when clicked.

Form Interactions

search

• Searches for a record with the same part number in the Machines table.
• Returns whether a match was found (fnd variable).

Error Handling

The code uses error handling mechanisms to catch and display errors that occur during execution. It also includes custom exit buttons (Err_Button190_Click, Err_Button194_Click, and Err_Button196_Click) to handle specific error scenarios.

Database Interactions

The code interacts with the database, creating and updating records in various tables (Machines, MachineNames, Process). It uses dynamic queries to retrieve data from these tables.

Global Variables

Several global variables are used throughout the code:

• dwncntL%, dwncntT%, dwncnt%: integer counters
• ToyClick%, ToyCaption%, Toys$(10): arrays and string variables