# Process Sheet test Analysis generated on: 4/1/2025 4:01:17 PM --- ## Record Source - *None* ## Controls | Control Name | Reference | |--------------|-----------| | Field113 | MetalType | | Field113 (Row Source) | [[Tables/[metalQ1];]] | | DatasheetFlag (Row Source) | | | Field325 | Warehouse | | Field325 (Row Source) | | | BlankSize | BlankSize | | PartSize | PartSize | | GrossWt | GrossWt | | ActualWt | ActualWt | | Utilization | Utilization | | SheetSize | SheetSize | | GrainDir | GrainDir | | GrainDir (Row Source) | | | BlocksPerSheet | BlocksPerSheet | | BlanksPerBlock | BlanksPerBlock | | PartsPerSheet | PartsPerSheet | | ActualPartHeight | ActualPartHeight | | PartCost | PartCost | | Field238 | PartsPerBlank | | PartNumber | PartNumber | | PartName | PartName | | IssueNumber | IssueNumber | | IssueDate | IssueDate | | PreviousIssue | PreviousIssue | | PreviousDate | PreviousDate | | Programmer | Programmer | | PrintSize | PrintSize | | History | History | | MetalType | MetalType | | MetalType (Row Source) | [[Tables/[metalQ1];]] | | FirstDim | FirstDim | | SecDim | SecDim | | BotTrimCut | BotTrimCut | | TopTrimCut | TopTrimCut | | CutType | CutType | | CutType (Row Source) | | | Deburr | Deburr | | Deburr (Row Source) | | | PartWidth | PartWidth | | ActualPartWidth | ActualPartWidth | | PartsPerBlank | PartsPerBlank | | PressBrake | PressBrake | | PressBrake (Row Source) | | | EntPartHeight | PartHeight | | Field240 | CellDeburrTypes | | Field240 (Row Source) | | | SavedProcesses (Row Source) | [[Tables/[QWorkCenters];]] | | AddnlDeburrInches | AddnlDeburrInches | | Reason | Reason | | PunchPressOption | PunchOption | | PunchCount | PunchPartsPerStrip | | PunchDie | PunchNumber | | PunchDie (Row Source) | [[Tables/punchpressQ1;]] | | GrainShearChk | GrainShear | | PunchStd | PunchStd | | PhantomNumber | PhantomNumber | | Gr3 | GrainNone | | PaperLaserFlag | PaperLaserFlag | | Pems | PemPress | | PemBefore | PemBefore | ## VBA Code ```vba 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 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 DocName = "Process Sheet Print" DoCmd.OpenReport DocName, A_PRINTALL, "Q1-14" + Chr$(34) 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 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 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 , , A_NEXT 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-14" + 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-14" + Chr$(34) Exit_Button309_Click: Exit Sub Err_Button309_Click: MsgBox Error$ Resume Exit_Button309_Click End Sub Private Sub Button322_Click() DoCmd.Hourglass True Call diskout DoCmd.Hourglass False End Sub Private Sub Button324_Click() 'add a data sheet for Eugene!!! End Sub Private Sub Button327_Click() DoCmd.Hourglass True p$ = currform.PartNumber If PaperLaserFlag Then PaperFlag$ = "1" Else PaperFlag$ = "0" Call LaserTapeGenerate(p$, PaperFlag$) 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 = "S:\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 Button200_Click p$ = currform.PartNumber Call CalcCNCRunTimes(p$) DoCmd.Hourglass False Refresh End Sub Private Sub Calculate_Click() Dim DocName As String Call Calculate_Button 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 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 Call CutTypeFormSettings Call PBFormView Call PemPressView GrainFromRec Call ErrorMessages Exit Sub BadRecord: l = 1 Resume Next End Sub Private Sub Form_Load() Set currform = Me On Error GoTo FL_die dwncntT% = 1 dwncntL% = 1 TextCalcErr.Visible = False TextCalcErr.Top = 2.58 * 1440 PrimaryScreen$ = "14" + Chr$(34) + " Process Sheet" 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 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 GrainShearChk_Click() Call CutTypeFormSettings End Sub Private Sub GrDirOpt_Click() NewGrain End Sub Private Sub MetalType_Click() Call CutTypeFormSettings 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 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 Toy_Click() If ToyCaption% = 0 Then Toy.FontSize = 18 Toy.Height = 1305 Toy.Width = 3570 dwncnt% = 1 End If ToyClick% = 1 End Sub ``` ## What it does # VBA Code Description ## Overview This VBA code is written for Microsoft Access and appears to be part of an application that manages parts, tools, and machines. The code is organized into several modules, each handling specific tasks. ## Module 1: Button Click Events ### `addPr_Click()` * Creates a new part with the name "NEW" and calls the `AddPartButton()` subroutine. * Uses the database order for string comparisons to ensure accurate results. ### `Button184_Click()` * Calls the `Add_Additional_Process()` subroutine, which is not defined in this code snippet. * Handles the error by displaying an error message and resuming the execution of the current subroutine. ### `Button190_Click()` * Attempts to quit the application with a "DoCmd.Quit" command. * If an error occurs, displays an error message using the `MsgBox` function and resumes the execution of the current subroutine. ### `Button193_Click()` * Retrieves the part number from the form's control "PartNumber". * Calls the `AddPartButton()` subroutine with the retrieved part number. * Uses the database order for string comparisons to ensure accurate results. ### `Button194_Click()` * Attempts to print a report using the `DoCmd.PrintOut` command. * If an error occurs, displays an error message and resumes the execution of the current subroutine. * Calls the `Refresh()` method to update the form's controls. ### `Button196_Click()` * Checks if the calculation status is not zero before printing a report. * If the calculation status is zero, displays an error message and exits the subroutine. * Calls the `Refresh()` method to update the form's controls. * Opens a report named "Process Sheet Print" using the `DoCmd.OpenReport` command. ## Module 2: Database Operations ### `search()` * Searches for a machine in the database with the same part number as the current part. * If found, adds a new record to the machines table. * Returns a boolean value indicating whether the search was successful (`True`) or not (`False`). ## Module 3: Form Operations ### `Button224_Click()` * Opens a form named "Data Sheet Select" using the `DoCmd.OpenForm` command. * Searches for records in the database with the same part number as the current part. * If found, selects an object from the primary screen using the `DoCmd.SelectObject` command. ### `Button246_Click()` * Calls the `HistoryR()` subroutine, which is not defined in this code snippet. ### `Button247_Click()` * Opens a form named "YESORNO" using the `DoCmd.OpenForm` command. * Displays a message box asking for confirmation to delete the part. * If confirmed, calls the `Delete_Part()` subroutine to delete the part. ### `Button248_Click()` * Calls the `Edit_The_Shear_Files()` subroutine, which is not defined in this code snippet. ### `Button249_Click()` * Calls the `Find_By_PartNumber()` subroutine, which is not defined in this code snippet. ### `Button288_Click()` * Retrieves the part number from the form's control "PartNumber". ## Notes * The `Add_Additional_Process` and `Edit_The_Shear_Files` subroutines are not defined in this code snippet. * The `HistoryR`, `Find_By_PartNumber`, and `Delete_Part` procedures are not defined in this code snippet. * This code appears to use several databases, including "MainDB", "MachNamesDB", and "MachQDB". * The code uses various commands, such as `DoCmd.Quit`, `DoCmd.PrintOut`, `DoCmd.OpenForm`, and `DoCmd.Close` to interact with the database and form objects.