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

16 KiB
Raw Blame History

Data Sheet Select

Record Source

Controls

Control Name Reference
Field1 PartNumber (from Tables/Process)

VBA Code

Option Compare Database   'Use database order for string comparisons

Private Sub AddAProcShet()
   Dim MainDB As Database, MainSet As Recordset
   Dim Main2DB As Database, Main2Set As Recordset
   Dim MachNamesDB As Database, MachNamesSet As Recordset
   Dim MachQDB As Database, MachQSet As Recordset

   Dim MainTableDef As TableDef

   Set MainDB = DBEngine.Workspaces(0).Databases(0)
   Set Main2DB = DBEngine.Workspaces(0).Databases(0)
   Set MachNamesDB = DBEngine.Workspaces(0).Databases(0)
   Set MachQDB = DBEngine.Workspaces(0).Databases(0)

   GoSub Open_Mains

   Set MachNamesSet = MachNamesDB.OpenRecordset("MachineNames", DB_OPEN_TABLE)   ' Create dynaset.
   Set MachQSet = MachQDB.OpenRecordset("Machines", DB_OPEN_TABLE)   ' Create dynaset.
   
   If (Not (IsNull(Field1))) Or (Trim$(NewPartName_Parm$) = "") Then
      PartN$ = Field1
      If PartN$ <> "" Then

         MainSet.AddNew
         MainSet.PartNumber = PartN$
         MainSet.Update
         Refresh
   
         MachNamesSet.MoveFirst
         While Not (MachNamesSet.EOF)
            A$ = MachNamesSet.MachineName
            MachQSet.AddNew
            MachQSet.MachineName = A$
            MachQSet.Tool = "***"
            MachQSet.PartNumber = PartN$
            MachQSet.Update
            MachNamesSet.MoveNext
         Wend
         Refresh
         If NewPartName_Parm$ <> "NEW" Then
            
            MainSet.Seek "=", NewPartName_Parm$
            Main2Set.Seek "=", PartN$

            Main2Set.Edit
            For i = 0 To MainSet.Fields.Count - 1
               Debug.Print "; "; MainSet.Fields(i).name
               If MainSet.Fields(i).name <> "PartNo" Then
                  Main2Set.Fields(i) = MainSet.Fields(i)
               End If
            Next i
            Main2Set.PartNumber = PartN$
            Main2Set.Update

            GoSub OPEN_Addnl

            MainSet.Seek "=", NewPartName_Parm$
            
            Do While Trim$(MainSet.PartNumber) = NewPartName_Parm$
               Main2Set.AddNew
               For i = 0 To MainSet.Fields.Count - 1
                  Debug.Print "; "; MainSet.Fields(i).name
                  If MainSet.Fields(i).name <> "PartNo" Then
                     Main2Set.Fields(i) = MainSet.Fields(i)
                  End If
               Next i
               Main2Set.PartNumber = PartN$
               Main2Set.Update
               MainSet.MoveNext
            Loop
            
            GoSub OPEN_Machs
            
            MainSet.Seek "=", NewPartName_Parm$
            Main2Set.Seek "=", PartN$
            
            Do While Trim$(MainSet.PartNumber) = NewPartName_Parm$
               Main2Set.Edit
               For i = 0 To MainSet.Fields.Count - 1
                  Debug.Print "; "; MainSet.Fields(i).name
                  If MainSet.Fields(i).name <> "PartNo" Then
                     Main2Set.Fields(i) = MainSet.Fields(i)
                  End If
               Next i
               Main2Set.PartNumber = PartN$
               Main2Set.Update
               MainSet.MoveNext
               Main2Set.MoveNext
            Loop

            GoSub Open_Mains
            
         End If
      End If
   End If
   Field1 = ""
Exit Sub

Open_Mains:
   Set MainSet = MainDB.OpenRecordset("Process", DB_OPEN_TABLE)   ' Create dynaset.
   Set Main2Set = Main2DB.OpenRecordset("Process", DB_OPEN_TABLE)   ' Create dynaset.
   MainSet.Index = "PrimaryKey"
   Main2Set.Index = "PrimaryKey"
Return

OPEN_Addnl:
   Set MainSet = MainDB.OpenRecordset("AddnlProc", DB_OPEN_TABLE)   ' Create dynaset.
   Set Main2Set = Main2DB.OpenRecordset("AddnlProc", DB_OPEN_TABLE)   ' Create dynaset.
   MainSet.Index = "PartNumber"
   Main2Set.Index = "PartNumber"
Return

OPEN_Machs:
   Set MainSet = MainDB.OpenRecordset("Machines", DB_OPEN_TABLE)   ' Create dynaset.
   Set Main2Set = Main2DB.OpenRecordset("Machines", DB_OPEN_TABLE)   ' Create dynaset.
   MainSet.Index = "PartNumber"
   Main2Set.Index = "PartNumber"
Return

End Sub

Private Sub Button0_Click()
On Error GoTo Err_Button0_Click

    Dim DocName As String
    Dim LinkCriteria As String
    PN$ = Field1

    DocName = PrimaryScreen$
    DoCmd.OpenForm DocName, , , LinkCriteria
    DoCmd.GoToControl "PartName"
    DoCmd.GoToControl "PartNumber"
    DoCmd.FindRecord PN$

    DoCmd.SelectObject A_FORM, "Data Sheet Select"
    DoCmd.Close
Exit_Button0_Click:
    Exit Sub

Err_Button0_Click:
    MsgBox Error$
    Resume Exit_Button0_Click
    
End Sub

Private Sub Button12_Click()
On Error GoTo Err_Button12_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DocName = "DS PressBrake"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'PRESSBRAKE')"
    DoCmd.OpenForm DocName, , , LinkCriteria

Exit_Button12_Click:
    Exit Sub

Err_Button12_Click:
    MsgBox Error$
    Resume Exit_Button12_Click
    
End Sub

Private Sub Button14_Click()
On Error GoTo Err_Button14_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DocName = "DS MultShear"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'MULTSHEAR')"
    DoCmd.OpenForm DocName, , , LinkCriteria

Exit_Button14_Click:
    Exit Sub

Err_Button14_Click:
    MsgBox Error$
    Resume Exit_Button14_Click
    


End Sub

Private Sub Button16_Click()
On Error GoTo Err_Button16_Click

    Dim DocName As String
    Dim LinkCriteria As String

    Refresh
    DocName = "Process Sheet Print"
    DoCmd.OpenReport DocName, A_PREVIEW, "Q2"
    
Exit_Button16_Click:
    Exit Sub

Err_Button16_Click:
    MsgBox Error$
    Resume Exit_Button16_Click

End Sub

Private Sub Button2_Click()
On Error GoTo Err_Button2_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DocName = "DS Laser"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'LASER')"
    DoCmd.OpenForm DocName, , , LinkCriteria

Exit_Button2_Click:
    Exit Sub

Err_Button2_Click:
    MsgBox Error$
    Resume Exit_Button2_Click
    

End Sub

Private Sub Button3_Click()
On Error GoTo Err_Button3_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DocName = "DS CNC"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'CNC')"
    DoCmd.OpenForm DocName, , , LinkCriteria

Exit_Button3_Click:
    Exit Sub

Err_Button3_Click:
    MsgBox Error$
    Resume Exit_Button3_Click
    
End Sub

Private Sub Button4_Click()
On Error GoTo Err_Button4_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DocName = "DS PressBrake"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'PRESSBRAKE')"
    DoCmd.OpenForm DocName, , , LinkCriteria

Exit_Button4_Click:
    Exit Sub

Err_Button4_Click:
    MsgBox Error$
    Resume Exit_Button4_Click

End Sub

Private Sub Button5_Click()
On Error GoTo Err_Button5_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DocName = "DS Shear"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'SHEAR')"
    DoCmd.OpenForm DocName, , , LinkCriteria

Exit_Button5_Click:
    Exit Sub

Err_Button5_Click:
    MsgBox Error$
    Resume Exit_Button5_Click


End Sub

Private Sub Button6_Click()
On Error GoTo Err_Button6_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DocName = "DS Timesaver"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'TIMESAVER')"
    DoCmd.OpenForm DocName, , , LinkCriteria

Exit_Button6_Click:
    Exit Sub

Err_Button6_Click:
    MsgBox Error$
    Resume Exit_Button6_Click
    

End Sub

Private Sub Button7_Click()
On Error GoTo Err_Button7_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DocName = "DS Hand Deburr"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'HANDDEBURR')"
    DoCmd.OpenForm DocName, , , LinkCriteria

Exit_Button7_Click:
    Exit Sub

Err_Button7_Click:
    MsgBox Error$
    Resume Exit_Button7_Click
    

End Sub

Private Sub Button8_Click()
On Error GoTo Err_Button8_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DocName = "DS Pedestal"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'PEDESTAL')"
    DoCmd.OpenForm DocName, , , LinkCriteria

Exit_Button8_Click:
    Exit Sub

Err_Button8_Click:
    MsgBox Error$
    Resume Exit_Button8_Click
    

End Sub

Private Sub Button9_Click()
On Error GoTo Err_Button9_Click

    Dim DocName As String
    Dim LinkCriteria As String
    Dim MyForm As Form

    
    DocName = "Process Sheet Print"
    DoCmd.OpenReport DocName, A_PREVIEW, "Q2"

    On Error GoTo tryNext: formExists = True
    DoCmd.SelectObject A_REPORT, "Process Sheet Print"
    If formExists Then
       DoCmd.PrintOut
       DoCmd.Close
    End If

    
    DocName = "DS Laser"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'LASER')"
    DoCmd.OpenForm DocName, , , LinkCriteria

    On Error GoTo tryNext: formExists = True
    DoCmd.SelectObject A_FORM, "DS Laser"
    If formExists Then
       DoCmd.PrintOut
       DoCmd.Close
    End If

    
    DocName = "DS CNC"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'CNC')"
    DoCmd.OpenForm DocName, , , LinkCriteria

    On Error GoTo tryNext: formExists = True
    DoCmd.SelectObject A_FORM, "DS CNC"
    If formExists Then
       DoCmd.PrintOut
       DoCmd.Close
    End If


    DocName = "DS PressBrake"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'PRESSBRAKE')"
    DoCmd.OpenForm DocName, , , LinkCriteria
    On Error GoTo tryNext: formExists = True
    DoCmd.SelectObject A_FORM, "DS PressBrake"
    If formExists Then
       DoCmd.PrintOut
       DoCmd.Close
    End If


    DocName = "DS Shear"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'SHEAR')"
    DoCmd.OpenForm DocName, , , LinkCriteria
    On Error GoTo tryNext: formExists = True
    DoCmd.SelectObject A_FORM, "DS Shear"
    If formExists Then
       DoCmd.PrintOut
       DoCmd.Close
    End If


    DocName = "DS Timesaver"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'TIMESAVER')"
    DoCmd.OpenForm DocName, , , LinkCriteria
    On Error GoTo tryNext: formExists = True
    DoCmd.SelectObject A_FORM, "DS Timesaver"
    If formExists Then
       DoCmd.PrintOut
       DoCmd.Close
    End If


    DocName = "DS Hand Deburr"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'HANDDEBURR')"
    DoCmd.OpenForm DocName, , , LinkCriteria
    On Error GoTo tryNext: formExists = True
    DoCmd.SelectObject A_FORM, "DS Hand Deburr"
    If formExists Then
       DoCmd.PrintOut
       DoCmd.Close
    End If


    DocName = "DS Pedestal"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'PEDESTAL')"
    DoCmd.OpenForm DocName, , , LinkCriteria
    On Error GoTo tryNext: formExists = True
    DoCmd.SelectObject A_FORM, "DS Pedestal"
    If formExists Then
       DoCmd.PrintOut
       DoCmd.Close
    End If

    DocName = "DS MultShear"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'MULTSHEAR')"
    DoCmd.OpenForm DocName, , , LinkCriteria
    On Error GoTo tryNext: formExists = True
    DoCmd.SelectObject A_FORM, "DS MultShear"
    If formExists Then
       DoCmd.PrintOut
       DoCmd.Close
    End If

    DocName = "DS Shake and Break"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'SHAKE')"
    DoCmd.OpenForm DocName, , , LinkCriteria
    On Error GoTo tryNext: formExists = True
    DoCmd.SelectObject A_FORM, "DS Shake and Break"
    If formExists Then
       DoCmd.PrintOut
       DoCmd.Close
    End If

Exit_Button9_Click:
    Exit Sub

Err_Button9_Click:
    MsgBox Error$
    Resume Exit_Button9_Click

tryNext:
    formExists = False
    Resume Next
    

End Sub

Private Sub Command17_Click()
On Error GoTo Err_Button17_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DocName = "DS Pem Press Manual"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'PEM')"
    DoCmd.OpenForm DocName, , , LinkCriteria

Exit_Button17_Click:
    Exit Sub

Err_Button17_Click:
    MsgBox Error$
    Resume Exit_Button17_Click

End Sub

Private Sub Command18_Click()
On Error GoTo Err_Button18_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DocName = "DS Shake and Break"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'SHAKEBREAK')"
    DoCmd.OpenForm DocName, , , LinkCriteria

Exit_Button18_Click:
    Exit Sub

Err_Button18_Click:
    MsgBox Error$
    Resume Exit_Button18_Click

End Sub

Private Sub Command19_Click()
On Error GoTo Err_Button19_Click

    Dim DocName As String
    Dim LinkCriteria As String

    DocName = "DS Salvagnini"
    LinkCriteria = "([PartNumber] = Forms![Data Sheet Select]![Field1]) and([SheetType] = 'SALVAGNINI')"
    DoCmd.OpenForm DocName, , , LinkCriteria

Exit_Button19_Click:
    Exit Sub

Err_Button19_Click:
    MsgBox Error$
    Resume Exit_Button19_Click
    

End Sub

What it does

AddAProcSheet VBA Code Description

This VBA code is used to automate the addition of new processes and machines records in a database, while also updating related additional process and machine records.

Initialization

The code begins by setting up various database connections:

  • MainDB, MainSet, MachNamesDB, MachQDB are databases and recordsets connected to the main workspace.
  • Main2DB and Main2Set are also connected to the main workspace.

Subroutine Flow

The code then calls the AddAProcShet subroutine, which performs the following actions:

  1. Open Main Databases: The GoSub Open_Mains subroutine is called to open the main databases (MainDB and Main2DB) and set up their recordsets.
  2. Check for Existing Data: The code checks if the Field1 value or the NewPartName_Parm$ parameter is not empty. If either condition is true, it proceeds with the addition of new records.

Add New Records

If the previous step passes, the code adds new records to the following tables:

  • Machine Names: A new machine name record is added for each existing machine in MachNamesSet.
  • Main Processes: If a part number is not empty, it creates a new main process record and updates the related additional process record.

Update Additional Process Records

If a part number is provided and it's not "NEW", the code:

  • Updates the main process record with the new part number.
  • Calls GoSub OPEN_Addnl to set up the additional process table connection.
  • Performs a full update of all records in the additional process table, ensuring that all fields match those in the main process table.

Update Machine Records

After updating the additional process records, the code:

  • Calls GoSub Open_Machs to open the machines recordset.
  • Performs a full update of all records in the machines table using the updated part number from the main process records.

Cleanup

Finally, the code resets the Field1 value and exits the subroutine.

Notes

  • The use of GoSub statements to call subroutines within the same code block is an older VBA feature. Modern VBA coding would typically avoid this practice.
  • The code uses Debug.Print statements for debugging purposes, which can be removed or replaced with more suitable error handling mechanisms in production environments.
  • The use of DB_OPEN_TABLE as a database open option may not be the most efficient choice, especially if dealing with large datasets.