# temp --- ## 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]]) | ## 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 Command357_Click() DoCmd.Hourglass True Call UpdateAS400 DoCmd.Hourglass False 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 ======================== This VBA code is designed for an Access database application, likely a machine shop management system. It contains various event handlers that control the behavior of different buttons and forms in the application. ## Button 184: Add Additional Process ------------------------------------ * When this button is clicked, it calls the `Add_Additional_Process` subroutine without any parameters. * The code is wrapped in an error handler (`Err_Button190_Click`) to catch any exceptions that may occur during execution. ## Button 193: Add Part Button ------------------------------ * This button calls the `AddPartButton` subroutine when clicked. * It retrieves the value of the `NewPartName_Parm$` variable, which is set to "NEW" by the `addPr_Click` event handler. * The code is also wrapped in an error handler (`Err_Button194_Click`) to catch any exceptions that may occur during execution. ## Button 196: Print Report ------------------------- * When this button is clicked, it checks if the calculation status of the part is valid (i.e., not equal to 0). * If valid, it refreshes the application and opens a report named "Process Sheet Print" in print mode (`A_PRINTALL`). * The code is wrapped in an error handler (`Err_Button196_Click`) to catch any exceptions that may occur during execution. ## Button 200: Machines Link --------------------------- * When this button is clicked, it: * Opens a database named "MachQDB" and retrieves the machines data set. * Calls the `search` subroutine to check if the part exists in the machines table. * If not found, it adds a new machine record with the specified part number. * The code is wrapped in an error handler (`Err_Button200_Click`) to catch any exceptions that may occur during execution. ## Button 204: Data Sheet Select ------------------------------- * When this button is clicked, it: * Opens a form named "Data Sheet Select" and sets the link criteria to the part number. * Finds the first record with the specified part number using `DoCmd.FindRecord`. * Retrieves the primary screen data set using `DoCmd.SelectObject A_FORM, PrimaryScreen$`. * The code is wrapped in an error handler (`Err_Button224_Click`) to catch any exceptions that may occur during execution. ## Button 246: History Report --------------------------- * When this button is clicked, it calls the `HistoryR` subroutine without any parameters. ## Button 247: Yes/No Confirmation ------------------------------- * When this button is clicked, it: * Opens a form named "YESORNO". * Enters the text "delete this part" into the YesOrNoStr$ variable. * Loops until YESORNO% \u003e 0, allowing the user to confirm or cancel the action. * If the user confirms (i.e., YESORNO% = 1), it calls the `Delete_Part` subroutine. ## Button 248: Edit Shear Files --------------------------- * When this button is clicked, it calls the `Edit_The_Shear_Files` subroutine without any parameters. ## Button 249: Find By Part Number ------------------------------- * When this button is clicked, it calls the `Find_By_PartNumber` subroutine without any parameters. ## Button 288: Get PN$ -------------------- * When this button is clicked, it retrieves the value of the part number from the current form using `Me![PartNumber]`. ## Buttons and Subroutines Overview -------------------------------------- The provided code snippet covers various event handlers for different buttons in an Access application. It contains a mix of data manipulation, report printing, and user confirmation subroutines, wrapped in error handling mechanisms to ensure robustness and fault tolerance. ### Key Functions * `AddPartButton`: Adds a new part record to the database. * `Print Report`: Prints a report with process sheet data. * `Machines Link`: Checks if a machine exists for the specified part number and adds it if not found. * `Data Sheet Select`: Opens a form to select data based on the part number. * `History Report`: Calls a subroutine to generate a history report. * `Yes/No Confirmation`: Displays a confirmation dialog box for deleting parts. * `Edit Shear Files` and `Find By Part Number`: Call subroutines related to editing shear files and finding parts by part numbers, respectively. ### Error Handling The code includes error handlers for each button's event handler to catch any exceptions that may occur during execution. This ensures that the application remains stable even in the presence of errors or unexpected user interactions.