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

1045 lines
26 KiB
Markdown
Raw Blame History

# Process Sheet
Analysis generated on: 4/1/2025 4:08:21 PM
---
## 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]]) |
| STSCode | STSCode (from [[Queries/UniversalQ]]) |
| chkRotateBlank | GrainShear (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 LogFile(currform!PartNumber, "Save As New Part")
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
If Left$(Initforms$, 2) = "14" Then
DocName = "Process Sheet Print 14"
DoCmd.OpenReport DocName, A_PRINTALL, "Q1-14" + Chr$(34)
Else
DocName = "Process Sheet Print"
DoCmd.OpenReport DocName, A_PRINTALL, "Q1"
End If
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
Programmer.SetFocus
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 LogFile(currform!PartNumber, "Delete Part")
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 , , acNext
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" + 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" + Chr$(34)
Exit_Button309_Click:
Exit Sub
Err_Button309_Click:
MsgBox Error$
Resume Exit_Button309_Click
End Sub
Private Sub Button322_Click()
Button322.Caption = "Processing"
DoCmd.Hourglass True
Call diskout
Call UpdateGWs
DoCmd.Hourglass False
Button322.Caption = "Create Disk Output"
Call LogFile(currform!PartNumber, "Create Disk Output")
End Sub
Private Sub Button327_Click()
DoCmd.Hourglass True
p$ = currform.PartNumber
If PaperLaserFlag Then PaperFlag$ = "1" Else PaperFlag$ = "0"
Call LaserTapeGenerate(p$, PaperFlag$, rst!)
'If Checkupload = True Then
'Call buttUpload_Click
'End If
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 = Directory$ & "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 MoveFilesToPrefixLocation
Call Button200_Click
p$ = currform.PartNumber
Call CalcCNCRunTimes(p$)
Call Button327_Click 'Laser Fun
If Checkupload = True Then
Call buttUpload_Click
End If
DoCmd.Hourglass False
Refresh
Call LogFile(currform!PartNumber, "Get Standard Machines")
End Sub
Private Sub MoveFilesToPrefixLocation()
'PartN$ = "2327979D"
PartN$ = currform![PartNumber]
Dim Prefix As String
Prefix = Left(PartN$, 3)
If UCase(Left(PartN$, 1)) = "Z" Then Prefix = "Z"
If UCase(Left(PartN$, 1)) = "X" Then Prefix = "X"
Dim DestinationFolder As String
Dim SourcePath As String
Dim FilesToDelete As String
Dim strFileName As String
Dim strFolder As String: strFolder = "S:\FL3030\"
'rob
nTC2020$ = "S:\TC2020\" + Trim(PartN$) + "T1.LST"
If Exists(nTC2020$) Then
strFolder = "S:\TC2020\"
nTC2020$ = "cmd /c copy S:\TC2020\" + Trim(PartN$) + "T1*.* S:\TC2020\" + Trim(PartN$) + "T2*.* /Y"
Shell (nTC2020$)
End If
'end rob
' TCL3030 Files
If Exists("S:\TCL3030\" + Trim(PartN$) + ".LST") Or Exists("S:\TCL3030\" + Trim(PartN$) + "L2.LST") Then
strFolder = "S:\TCL3030\"
End If
Dim strFileSpec As String: strFileSpec = strFolder & "*.*"
DestinationFolder = strFolder & Prefix
CreateDir (DestinationFolder)
strFileName = Dir(strFileSpec)
FilesToDelete = ""
Do While Len(strFileName) > 0
Debug.Print strFileName
If InStr(1, strFileName, PartN$, vbTextCompare) Then
SourcePath = strFolder & strFileName
FileCopy SourcePath, DestinationFolder & "\" & strFileName
FilesToDelete = FilesToDelete & SourcePath & vbCrLf
End If
strFileName = Dir
Loop
Dim MyFile() As String
MyFile = Split(FilesToDelete, vbCrLf)
For Each XFile In MyFile
If XFile <> "" Then
Kill (XFile)
End If
Next
Debug.Print FilesToDelete
End Sub
Private Sub Calculate_Click()
Dim DocName As String
Call Calculate_Button
Call LogFile(currform!PartNumber, "Calculate")
End Sub
Private Sub cmd300Series_Click()
DoCmd.Hourglass True
Set XrefQDB = DBEngine.Workspaces(0).Databases(0)
Set XrefQSet = XrefQDB.OpenRecordset("RMSFILES#_EGSSP1A0", DB_OPEN_DYNASET) ' Create dynaset.
XrefQSet.MoveFirst
PartN$ = currform![PartNumber]
xPN$ = Left(currform![PartNumber], 7)
newnum$ = ""
Do Until XrefQSet.EOF
If (Trim(XrefQSet!CURPN) = xPN$) Then
newnum$ = Trim(XrefQSet!NEWPN)
If newnum$ <> "" Then
newnum$ = newnum$ + Right(Trim(PartN$), 1)
End If
Exit Do
End If
XrefQSet.MoveNext
Loop
If newnum$ <> "" Then
Curprt$ = Directory$ + "VLT1\" + revext(PartN$)
If Exists(Curprt$) Then
NewPrt$ = Directory$ + "VLT1\" + revext(newnum$)
Open Curprt$ For Input As #1
Open NewPrt$ For Output As #2
While Not EOF(1)
Line Input #1, A$
If InStr(A$, PartN$) <> 0 Then
A$ = ReplaceStr(A$, PartN$, newnum$)
End If
Print #2, A$
Wend
Close #1, #2
End If
Curprt$ = Directory$ + "VT2\" + revext(PartN$)
If Exists(Curprt$) Then
NewPrt$ = Directory$ + "VT2\" + revext(newnum$)
Open Curprt$ For Input As #1
Open NewPrt$ For Output As #2
While Not EOF(1)
Line Input #1, A$
If InStr(A$, PartN$) <> 0 Then
A$ = ReplaceStr(A$, PartN$, newnum$)
End If
Print #2, A$
Wend
Close #1, #2
End If
End If
DoCmd.Hourglass False
End Sub
Function revext(p$)
revext = Left(p$, 7) + "." + Right(p$, 1)
End Function
Public Function ReplaceStr$(source$, Target$, Replc$)
'
'Replaces each instance of the string Target$ with the string Replc$ in the string Source$
'
NS$ = source$
FromPl% = 1
While InStr(Mid$(UCase$(NS$), FromPl%), UCase$(Target$)) <> 0
A% = InStr(Mid$(UCase$(NS$), FromPl%), UCase$(Target$))
A% = A% + FromPl% - 1
NS$ = Left$(NS$, A% - 1) + Replc$ + Mid$(NS$, A% + Len(Target$))
FromPl% = A% + Len(Replc$)
Wend
ReplaceStr$ = NS$
End Function
Private Sub cmdDeleteFileFromTrumpfs_Click()
On Error Resume Next
Dim x As String
x = "S:\Garrett\Trumpf_Clean_Machine\TrumpfReports\" & PartNumber
If Not Exists(x) Then
Open x For Output As #2
Print #2, Now()
Close #2
End If
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 UpdateGWs
DoCmd.Hourglass False
End Sub
Sub UpdateGWs()
Dim MainDB As Database, MainSet As Recordset
Dim Main2DB As Database, Main2Set As Recordset
Set MainDB = DBEngine.Workspaces(0).Databases(0)
' currform.Refresh
PN$ = currform!PartNumber
'PN$ = Left$(PN$, 7)
PN$ = Mid(PN$, 1, Len(PN$) - 1)
wh$ = currform!Warehouse
Set Main2Set = MainDB.OpenRecordset("RMSFILES#_MFWKP795", DB_OPEN_DYNASET) ' Create dynaset.
On Error Resume Next
Main2Set.MoveFirst
On Error GoTo 0
Users$ = Trim(myNTUserName$)
Do
If Not (Main2Set.EOF) Then
If Trim$(Main2Set![UID]) = Users$ Then
Main2Set.Delete
End If
DoEvents
Else
DoEvents
Exit Do
End If
Main2Set.MoveNext
Loop
Gws$ = Format(itsaNull$(currform!GrossWt), "#.000")
aws$ = Format(itsaNull$(currform!ActualWt), "#.000")
matl$ = currform!Field113.Column(2)
pps$ = currform!PartsPerSheet
If currform!PartsPerBlank.Visible = True Then
ppb$ = currform!PartsPerBlank
Else
ppb$ = currform!BlanksPerBlock
End If
Main2Set.AddNew
Main2Set![UID] = Users$
Main2Set!PRDNO = PN$
Main2Set!KBLWH = wh$
Main2Set!netwt = aws$
Main2Set!GRSwt = Gws$
Main2Set![MATL#] = matl$
Main2Set!SSIZE3 = pps$
Main2Set!BSIZE3 = ppb$
Main2Set.Update
Main2Set.Close
MainDB.Close
'ActiveXCtl358.CommandString = "Call PGM(MFR795) PARM('" + Users$ + "')"
'currform! .DoClick
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
lblXrefMessage.Visible = False
cmd300Series.Visible = False
Call CrossRef
Call CutTypeFormSettings
Call PBFormView
Call PemPressView
GrainFromRec
lblDedicatedCell.Caption = GetLineFromDedicated(Me!PartNumber)
Call ErrorMessages
Exit Sub
BadRecord:
l = 1
Resume Next
End Sub
Private Function GetLineFromDedicated(Pnnum As String) As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim i As Integer
Dim wrk, sql, Mach As String
wrk = Trim(Pnnum)
sql = "SELECT ProductMaster.PRDNO, DedicatedCells.Active, DedicatedCells.AlphaCode, DedicatedCells.Machine"
sql = sql + " FROM ProductMaster INNER JOIN DedicatedCells ON ProductMaster.PALPH = DedicatedCells.AlphaCode"
sql = sql + " WHERE (((ProductMaster.PRDNO)='" + Left(wrk, 7) + "') AND ((DedicatedCells.Active)=True));"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sql)
Mach = ""
If rst.recordCount > 0 Then
rst.MoveFirst
Mach = rst!Machine
End If
GetLineFromDedicated = Mach
End Function
Private Sub Form_Load()
Set currform = Me
On Error GoTo FL_die
dwncntT% = 1
dwncntL% = 1
TextCalcErr.Visible = False
TextCalcErr.Top = 2.58 * 1440
If Left$(Initforms$, 2) = "14" Then
DocName$ = "14" + Chr$(34) + " Process Sheet"
Else
DocName$ = "Process Sheet"
End If
PrimaryScreen$ = DocName$
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 what 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 Form_Unload(Cancel As Integer)
DoCmd.Close acForm, "Filtered Parts"
End Sub
Private Sub GrainShearChk_Click()
Call CutTypeFormSettings
End Sub
Private Sub GrDirOpt_Click()
NewGrain
End Sub
Private Sub Info_Click()
Call gatherinfo
Button246.SetFocus
End Sub
Private Sub MetalType_Click()
Call CutTypeFormSettings
End Sub
Private Sub PartNumber_GotFocus()
' If itsaNull(PartName) = "" Then
'Info.Visible = True
'Else
'Info.Visible = False
'End If
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 Programmer_LostFocus()
' a$ = Me![Programmer]
'
' If a$ = "SG" Or a$ = "CB" Or a$ = "ST" Or a$ = "KL" Then
' Checkupload = True
' Else
' Checkupload = False
' End If
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 Text191_DblClick(Cancel As Integer)
DoCmd.OpenQuery "LogFileQ", acViewNormal, acReadOnly
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
Sub gatherinfo()
On Error Resume Next
Dim rs As DAO.Recordset
Dim db As Database
Dim strSQL As String
Set db = CurrentDb()
Part = Mid(PartNumber, 1, Len(PartNumber) - 1)
strSQL = "select * from ProductMaster WHERE PRDNO = '" & Part & "'"
Set rs = db.OpenRecordset(strSQL)
'Debug.Print rs![PRDNO] & " | " & rs![DESCP]
PartName = Trim(rs![DESCP])
End Sub
```
## What it does
# VBA Code Documentation
This VBA code is written in Access and appears to be part of a database application. It contains several subroutines that perform various actions, such as adding parts, printing reports, and interacting with forms.
## addPr_Click Subroutine
This subroutine is called when the `addPr` button is clicked. It sets the `NewPartName_Parm$` variable to "NEW" and calls the `AddPartButton` subroutine.
```markdown
# addPr_Click Subroutine
* Sets NewPartName_Parm$ to "NEW"
* Calls AddPartButton subroutine
```
## Button184_Click Subroutine
This subroutine is called when the button with ID 184 is clicked. It calls the `Add_Additional_Process` subroutine.
```markdown
# Button184_Click Subroutine
* Calls Add_Additional_Process subroutine
```
## Button190_Click Subroutine
This subroutine is called when the button with ID 190 is clicked. It attempts to quit the database application and displays an error message if an error occurs.
```markdown
# Button190_Click Subroutine
* Attempts to quit the database application
* Displays error message if an error occurs
```
## Button193_Click Subroutine
This subroutine is called when the button with ID 193 is clicked. It sets the `NewPartName_Parm$` variable to the value of the `PartNumber` field in the current form and calls the `LogFile` subroutine.
```markdown
# Button193_Click Subroutine
* Sets NewPartName_Parm$ to the value of PartNumber field in current form
* Calls LogFile subroutine
```
## Button194_Click Subroutine
This subroutine is called when the button with ID 194 is clicked. It prints the data from the `PrimaryScreen` form and displays an error message if an error occurs.
```markdown
# Button194_Click Subroutine
* Prints data from PrimaryScreen form
* Displays error message if an error occurs
```
## Button196_Click Subroutine
This subroutine is called when the button with ID 196 is clicked. It checks if the calculation status of a part is in error and displays a message box accordingly. If not, it calls the `Refresh` subroutine.
```markdown
# Button196_Click Subroutine
* Checks if calculation status of part is in error
* Displays message box if error occurs
* Calls Refresh subroutine if no error
```
## search Subroutine
This subroutine is called within the `Button200_Click` subroutine. It searches for a machine name that matches the value of the `PartNumber` field and returns true or false depending on whether a match is found.
```markdown
# search Subroutine
* Searches for machine name matching PartNumber field
* Returns true if match is found, false otherwise
```
## Button200_Click Subroutine
This subroutine is called when the button with ID 200 is clicked. It opens forms to select machines and processes data from the `Machines` table.
```markdown
# Button200_Click Subroutine
* Opens form to select machines
* Processes data from Machines table
```
## Button244_Click Subroutine
This subroutine is called when the button with ID 244 is clicked. It opens a form to select a data sheet and displays an error message if an error occurs.
```markdown
# Button244_Click Subroutine
* Opens form to select data sheet
* Displays error message if an error occurs
```
## Button247_Click Subroutine
This subroutine is called when the button with ID 247 is clicked. It calls the `HistoryR` subroutine and focuses on the programmer.
```markdown
# Button247_Click Subroutine
* Calls HistoryR subroutine
* Focuses on programmer
```
Reference in New Issue View Git Blame Copy Permalink