Cybernomad
/
PSLine2000Documentation
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects 1 Releases Wiki Activity
PSLine2000Documentation/Forms/temp.md

20 KiB
Raw Permalink Blame History

temp

Record Source

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

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.