600 lines
16 KiB
Markdown
600 lines
16 KiB
Markdown
# Data Sheet Select
|
|
---
|
|
## Record Source
|
|
- [[Tables/Process]]
|
|
## Controls
|
|
| Control Name | Reference |
|
|
|--------------|-----------|
|
|
| Field1 | PartNumber (from [[Tables/Process]]) |
|
|
## VBA Code
|
|
```vba
|
|
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.
|