# TRASH --- ## 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 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 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 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() 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$ = 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!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 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 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() Dim arrray$(100) 'Part$ = txtPartNumber 'hide when trying itsazero 'Min$ = LTrim(Left$(a$, 2)) Part1$ = Trim(Left$(PartNumber, 7)) Part2$ = Trim(Right$(PartNumber, 1)) Part$ = itsaNull(Part1$ + "." + Part2$) If Exists("\\fryfs002v\ie1\sys\shoplink\vt2\" & Part$) Then Call loadCull(arrray$(), "\\fryfs002v\ie1\sys\shoplink\Vt2\" & Part$) PartName.Value = Cull2(arrray$(), "(PART NAME :", "0") Reason.Value = Cull2(arrray(), "(JOB NUMBER :", "0") End If If Exists("\\fryfs002v\ie1\sys\shoplink\vlt1\" & Part$) Then Call loadCull(arrray$(), "\\fryfs002v\ie1\sys\shoplink\vlt1\" & Part$) PartName.Value = Cull(arrray$(), "(PART NAME :", "0") Reason.Value = Cull(arrray(), "(JOB NUMBER :", "0") End If 'If PartName = 0 Or itsaNull(PartName) = "" Then 'Call loadCull(arrray$(), "\\fryfs002v\ie1\sys\shoplink\Vt2\" & Part$) 'PartName.Value = Cull2(arrray$(), "(PART NAME :", "0") 'Reason.Value = Cull2(arrray(), "(JOB NUMBER :", "0") 'End If 'If PartName = 0 Or itsaNull(PartName) = "" Then 'Call loadCull(arrray$(), "\\fryfs002v\ie1\sys\shoplink\Vlt1\" & Part$) 'PartName.Value = Cull(arrray$(), "(PART NAME :", "0") 'Reason.Value = Cull(arrray(), "(JOB NUMBER :", "0") 'End If 'xxx$ = Cull(arrray$(), "FormWidth", "0") 'frmmain.Width = Val(xxx$) End Sub ``` ## What it does **VBA Code Description** ========================= This VBA code is designed to interact with an Access database. It appears to be part of a larger application, possibly a manufacturing or inventory management system. **Button Click Event Handlers** ----------------------------- The code contains several button click event handlers: * `addPr_Click`: Sets the `NewPartName_Parm$` variable to "NEW" and calls the `AddPartButton` subroutine. * `Button184_Click`: Calls the `Add_Additional_Process` subroutine without any parameters. * `Button190_Click`: Quits the application when clicked. If an error occurs, displays an error message and resumes the quit process. * `Button193_Click`: Sets the `NewPartName_Parm$` variable to the current part number and calls the `AddPartButton` subroutine. * `Button194_Click`: Prints out a report without any parameters. If an error occurs, displays an error message and resumes the print process. **Other Subroutines** --------------------- The code contains several other subroutines: * `search`: Searches for a part in the database based on the current form's primary key (part number). If the part is not found, it adds a new record to the "Machines" table with an unknown tool and part number. * `HistoryR`: Calls the history report subroutine without any parameters. * `Delete_Part`: Deletes a part from the database when called. **Database Interactions** ------------------------- The code interacts with the Access database in several ways: * It opens various tables, such as "Process", "Machines", and "MachineNames". * It performs CRUD (create, read, update, delete) operations on these tables. * It uses error handling to catch and display any errors that occur during these interactions. **Form Interactions** ------------------- The code interacts with forms in several ways: * It opens and closes various forms using the `DoCmd.OpenForm` and `DoCmd.Close` methods. * It uses form-level variables, such as `Me!PartNumber`, to access part numbers and other form-specific data. **Notes** -------- * The code uses Access database objects, such as databases, tables, forms, and recordsets, which may require additional setup or configuration to work properly. * Some of the variable names and subroutine names follow a consistent naming convention, while others do not. This inconsistency may make it difficult to understand the code without additional context. **Improvement Suggestions** --------------------------- * Consider refactoring the code to reduce duplication and improve maintainability. * Use more descriptive variable names and subroutine names to make the code easier to understand. * Add additional error handling or logging mechanisms to improve the application's reliability and debugging capabilities.