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

715 lines
20 KiB
Markdown
Raw Permalink Blame History

# temp
---
## Record Source
- [[Queries/UniversalQ]]
## 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
```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 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.
Reference in New Issue View Git Blame Copy Permalink