# 14_ 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]]) | ## VBA Code ```vba Option Compare Database 'Use database order for string comparisons Dim dwncntL%, dwncntT%, dwncnt%, ToyClick%, ToyCaption%, Toys$(10) Private Sub ActiveXCtl358_Click() End Sub Private Sub ActiveXCtl358_CommandComplete(ByVal returnValue As Long) End Sub 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 14" 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 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 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-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 Call UpdateGWs DoCmd.Hourglass False End Sub Private Sub Button327_Click() DoCmd.Hourglass True p$ = currform.PartNumber If PaperLaserFlag Then PaperFlag$ = "1" Else PaperFlag$ = "0" Call LaserTapeGenerate(p$, PaperFlag$) 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 = "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$) If Checkupload = True Then Call buttUpload_Click End If 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 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) 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$ = 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!ActiveXCtl358.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 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 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 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 Programmer_LostFocus() A$ = Me![Programmer] If A$ = "SG" Or A$ = "CB" 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 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** ========================== This VBA code is written for a Microsoft Access database application. It appears to be part of an inventory management system, handling various tasks such as adding parts, printing reports, and managing machine data. **Module Overview** -------------------- The code consists of several private subroutines that are called in response to button clicks or other events. These subroutines perform specific actions, such as: * Opening and closing forms * Printing reports * Adding parts to the inventory * Managing machine data * Handling errors **Subroutine Descriptions** --------------------------- ### Button Click Subroutines * `addPr_Click()`: Opens a new part form by calling the `AddPartButton` subroutine. * `Button184_Click()`: Calls the `Add_Additional_Process` subroutine, which is not shown in this code snippet. * `Button190_Click()`: Attempts to quit the application. If successful, it calls an `Exit_Button190_Click` label to exit the subroutine. If not, it displays an error message and continues execution. * `Button193_Click()`: Calls the `AddPartButton` subroutine with the current part number as a parameter. * `Button194_Click()`: Opens a report form by calling the `DoCmd.PrintOut` method. It also attempts to select the primary screen object. If successful, it calls an `Exit_Button194_Click` label to exit the subroutine. If not, it displays an error message and continues execution. * `Button196_Click()`: Calls the `Refresh` subroutine and opens a report form named "Process Sheet Print 14". It also attempts to select the primary screen object. ### Error Handling Subroutines * `Err_Button190_Click`, `Err_Button194_Click`, and `Err_Button196_Click`: Display error messages and resume execution of the corresponding subroutine labels. ### Machine Data Management Subroutine * `Button200_Click()`: Opens database connections to multiple tables, such as "MachineNames" and "Machines". It then iterates over the records in these tables, checks for matches with the current part number, and adds new machines to the inventory if necessary. Finally, it calls the `Refresh` subroutine. ### History and Delete Subroutines * `Button246_Click()`: Calls the `HistoryR` subroutine (not shown) and sets focus to a specific control. * `Button247_Click()`: Opens a form named "YESORNO" and waits for user input. If the response is not 1, it calls the `Delete_Part` subroutine. ### Miscellaneous Subroutines * `search`: A subroutine called within `Button200_Click()` to search for matches between part numbers and machine names. * `AddPartButton`, `Add_Additional_Process`, `HistoryR`, and `Delete_Part`: These subroutines are not shown in this code snippet but are likely used elsewhere in the application. **Notes** -------- This VBA code appears to be designed for an inventory management system, handling various tasks related to part numbers, machine data, and report printing. The code could benefit from additional error checking, comments, and organization to improve maintainability and readability.