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

18 KiB
Raw Blame History

14 two

Record Source

Controls

Control Name Reference
Field113 MetalType (from Tables/Util Selection C1)
Field113 (Row Source) Tables/[metalQ1];
DatasheetFlag (Row Source)
Field325 Warehouse (from Tables/Util Selection C1)
Field325 (Row Source)
BlankSize BlankSize (from Tables/Util Selection C1)
PartSize PartSize (from Tables/Util Selection C1)
GrossWt GrossWt (from Tables/Util Selection C1)
ActualWt ActualWt (from Tables/Util Selection C1)
Utilization Utilization (from Tables/Util Selection C1)
SheetSize SheetSize (from Tables/Util Selection C1)
GrainDir GrainDir (from Tables/Util Selection C1)
GrainDir (Row Source)
BlocksPerSheet BlocksPerSheet (from Tables/Util Selection C1)
BlanksPerBlock BlanksPerBlock (from Tables/Util Selection C1)
PartsPerSheet PartsPerSheet (from Tables/Util Selection C1)
ActualPartHeight ActualPartHeight (from Tables/Util Selection C1)
PartCost PartCost (from Tables/Util Selection C1)
Field238 PartsPerBlank (from Tables/Util Selection C1)
PartNumber PartNumber (from Tables/Util Selection C1)
PartName PartName (from Tables/Util Selection C1)
IssueNumber IssueNumber (from Tables/Util Selection C1)
IssueDate IssueDate (from Tables/Util Selection C1)
PreviousIssue PreviousIssue (from Tables/Util Selection C1)
PreviousDate PreviousDate (from Tables/Util Selection C1)
Programmer Programmer (from Tables/Util Selection C1)
PrintSize PrintSize (from Tables/Util Selection C1)
History History (from Tables/Util Selection C1)
MetalType MetalType (from Tables/Util Selection C1)
MetalType (Row Source) Tables/[metalQ1];
FirstDim FirstDim (from Tables/Util Selection C1)
SecDim SecDim (from Tables/Util Selection C1)
BotTrimCut BotTrimCut (from Tables/Util Selection C1)
TopTrimCut TopTrimCut (from Tables/Util Selection C1)
CutType CutType (from Tables/Util Selection C1)
CutType (Row Source)
Deburr Deburr (from Tables/Util Selection C1)
Deburr (Row Source)
PartWidth PartWidth (from Tables/Util Selection C1)
ActualPartWidth ActualPartWidth (from Tables/Util Selection C1)
PartsPerBlank PartsPerBlank (from Tables/Util Selection C1)
PressBrake PressBrake (from Tables/Util Selection C1)
PressBrake (Row Source) Tables/[PressBrakes];
EntPartHeight PartHeight (from Tables/Util Selection C1)
Field240 CellDeburrTypes (from Tables/Util Selection C1)
Field240 (Row Source)
SavedProcesses (Row Source) Tables/[QWorkCenters];
AddnlDeburrInches AddnlDeburrInches (from Tables/Util Selection C1)
Reason Reason (from Tables/Util Selection C1)
PunchPressOption PunchOption (from Tables/Util Selection C1)
PunchCount PunchPartsPerStrip (from Tables/Util Selection C1)
PunchDie PunchNumber (from Tables/Util Selection C1)
PunchDie (Row Source) Tables/punchpressQ1;
GrainShearChk GrainShear (from Tables/Util Selection C1)
PunchStd PunchStd (from Tables/Util Selection C1)
PhantomNumber PhantomNumber (from Tables/Util Selection C1)
Gr3 GrainNone (from Tables/Util Selection C1)
PaperLaserFlag PaperLaserFlag (from Tables/Util Selection C1)

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()
   Call diskout
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
   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 PressBrake_Click()
  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 part of a Microsoft Access database application. It appears to be a custom form with various buttons and subroutines that perform different actions.

Button Subroutines

addPr_Click()

  • When the "addPr" button is clicked, it sets NewPartName_Parm$ to "NEW" and calls the AddPartButton subroutine.
  • This action is likely used to create a new part in the database.

Button184_Click()

  • When the second button (184) is clicked, it calls the Add_Additional_Process subroutine without any parameters.

Button190_Click()

  • When the third button (190) is clicked, it attempts to quit the application using DoCmd.Quit.
  • If an error occurs during this process, it jumps back to the Err_Button190_Click label and displays an error message.
  • If the operation succeeds, it proceeds to the next step.

Button193_Click()

  • When the fourth button (193) is clicked, it sets NewPartName_Parm$ to the current value of Me!PartNumber.
  • It then calls the AddPartButton subroutine using the updated part number.
  • This action appears to be used for creating or updating a part in the database.

Button194_Click()

  • When the fifth button (194) is clicked, it attempts to print an existing report named "Primary Screen".
  • If any errors occur during this process, it jumps back to the Err_Button194_Click label and displays an error message.
  • If the operation succeeds, it proceeds to refresh the form.

Button196_Click()

  • When the seventh button (196) is clicked, it checks if there are any calculations in progress by looking at the calculation status of the current form.
  • If there are calculations, it sets a variable M$ to an error message and displays a messagebox with this value.
  • It then attempts to refresh the report named "Process Sheet Print".
  • If any errors occur during this process, it jumps back to the Err_Button196_Click label and displays an error message.

Button200_Click()

  • When the eighth button (200) is clicked, it opens three database tables: MainDB, MachNamesDB, and MachQDB.
  • It then sets up recordsets for these tables and performs a series of searches to find matching machines based on the current part number.
  • If any errors occur during this process, it jumps back to the Err_Button200_Click label and displays an error message.

Button244_Click()

  • When the twenty-fourth button (244) is clicked, it opens a new form named "Data Sheet Select" with a link criterion that finds records based on the current part number.
  • It then attempts to find a record in this table using DoCmd.FindRecord.
  • If successful, it selects the primary screen and closes the data sheet select form.

Button246_Click()

  • When the twenty-sixth button (246) is clicked, it calls the HistoryR subroutine without any parameters.

Button247_Click()

  • When the twenty-seventh button (247) is clicked, it opens a new form named "YESORNO" with a message asking to delete the current part.
  • It then enters an infinite loop until the user clicks "1" in the message box. If the user chooses not to delete the part, it exits the subroutine.

Button248_Click()

  • When the twenty-eighth button (248) is clicked, it calls the Edit_The_Shear_Files subroutine without any parameters.

Button249_Click()

  • When the twenty-ninth button (249) is clicked, it calls the Find_By_PartNumber subroutine without any parameters.