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

705 lines
17 KiB
Markdown
Raw Blame History

# Process Sheet test
Analysis generated on: 4/1/2025 4:01:17 PM
---
## Record Source
- *None*
## Controls
| Control Name | Reference |
|--------------|-----------|
| Field113 | MetalType |
| Field113 (Row Source) | [[Tables/[metalQ1];]] |
| DatasheetFlag (Row Source) | |
| Field325 | Warehouse |
| Field325 (Row Source) | |
| BlankSize | BlankSize |
| PartSize | PartSize |
| GrossWt | GrossWt |
| ActualWt | ActualWt |
| Utilization | Utilization |
| SheetSize | SheetSize |
| GrainDir | GrainDir |
| GrainDir (Row Source) | |
| BlocksPerSheet | BlocksPerSheet |
| BlanksPerBlock | BlanksPerBlock |
| PartsPerSheet | PartsPerSheet |
| ActualPartHeight | ActualPartHeight |
| PartCost | PartCost |
| Field238 | PartsPerBlank |
| PartNumber | PartNumber |
| PartName | PartName |
| IssueNumber | IssueNumber |
| IssueDate | IssueDate |
| PreviousIssue | PreviousIssue |
| PreviousDate | PreviousDate |
| Programmer | Programmer |
| PrintSize | PrintSize |
| History | History |
| MetalType | MetalType |
| MetalType (Row Source) | [[Tables/[metalQ1];]] |
| FirstDim | FirstDim |
| SecDim | SecDim |
| BotTrimCut | BotTrimCut |
| TopTrimCut | TopTrimCut |
| CutType | CutType |
| CutType (Row Source) | |
| Deburr | Deburr |
| Deburr (Row Source) | |
| PartWidth | PartWidth |
| ActualPartWidth | ActualPartWidth |
| PartsPerBlank | PartsPerBlank |
| PressBrake | PressBrake |
| PressBrake (Row Source) | |
| EntPartHeight | PartHeight |
| Field240 | CellDeburrTypes |
| Field240 (Row Source) | |
| SavedProcesses (Row Source) | [[Tables/[QWorkCenters];]] |
| AddnlDeburrInches | AddnlDeburrInches |
| Reason | Reason |
| PunchPressOption | PunchOption |
| PunchCount | PunchPartsPerStrip |
| PunchDie | PunchNumber |
| PunchDie (Row Source) | [[Tables/punchpressQ1;]] |
| GrainShearChk | GrainShear |
| PunchStd | PunchStd |
| PhantomNumber | PhantomNumber |
| Gr3 | GrainNone |
| PaperLaserFlag | PaperLaserFlag |
| Pems | PemPress |
| PemBefore | PemBefore |
## 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
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 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
## Overview
This VBA code is written for Microsoft Access and appears to be part of an application that manages parts, tools, and machines. The code is organized into several modules, each handling specific tasks.
## Module 1: Button Click Events
### `addPr_Click()`
* Creates a new part with the name "NEW" and calls the `AddPartButton()` subroutine.
* Uses the database order for string comparisons to ensure accurate results.
### `Button184_Click()`
* Calls the `Add_Additional_Process()` subroutine, which is not defined in this code snippet.
* Handles the error by displaying an error message and resuming the execution of the current subroutine.
### `Button190_Click()`
* Attempts to quit the application with a "DoCmd.Quit" command.
* If an error occurs, displays an error message using the `MsgBox` function and resumes the execution of the current subroutine.
### `Button193_Click()`
* Retrieves the part number from the form's control "PartNumber".
* Calls the `AddPartButton()` subroutine with the retrieved part number.
* Uses the database order for string comparisons to ensure accurate results.
### `Button194_Click()`
* Attempts to print a report using the `DoCmd.PrintOut` command.
* If an error occurs, displays an error message and resumes the execution of the current subroutine.
* Calls the `Refresh()` method to update the form's controls.
### `Button196_Click()`
* Checks if the calculation status is not zero before printing a report.
* If the calculation status is zero, displays an error message and exits the subroutine.
* Calls the `Refresh()` method to update the form's controls.
* Opens a report named "Process Sheet Print" using the `DoCmd.OpenReport` command.
## Module 2: Database Operations
### `search()`
* Searches for a machine in the database with the same part number as the current part.
* If found, adds a new record to the machines table.
* Returns a boolean value indicating whether the search was successful (`True`) or not (`False`).
## Module 3: Form Operations
### `Button224_Click()`
* Opens a form named "Data Sheet Select" using the `DoCmd.OpenForm` command.
* Searches for records in the database with the same part number as the current part.
* If found, selects an object from the primary screen using the `DoCmd.SelectObject` command.
### `Button246_Click()`
* Calls the `HistoryR()` subroutine, which is not defined in this code snippet.
### `Button247_Click()`
* Opens a form named "YESORNO" using the `DoCmd.OpenForm` command.
* Displays a message box asking for confirmation to delete the part.
* If confirmed, calls the `Delete_Part()` subroutine to delete the part.
### `Button248_Click()`
* Calls the `Edit_The_Shear_Files()` subroutine, which is not defined in this code snippet.
### `Button249_Click()`
* Calls the `Find_By_PartNumber()` subroutine, which is not defined in this code snippet.
### `Button288_Click()`
* Retrieves the part number from the form's control "PartNumber".
## Notes
* The `Add_Additional_Process` and `Edit_The_Shear_Files` subroutines are not defined in this code snippet.
* The `HistoryR`, `Find_By_PartNumber`, and `Delete_Part` procedures are not defined in this code snippet.
* This code appears to use several databases, including "MainDB", "MachNamesDB", and "MachQDB".
* The code uses various commands, such as `DoCmd.Quit`, `DoCmd.PrintOut`, `DoCmd.OpenForm`, and `DoCmd.Close` to interact with the database and form objects.
Reference in New Issue View Git Blame Copy Permalink