OK here is the whole routine, I did not write it so I'm
not sure what it is doing. If it does need to be updated
to VBA, is there an easy way to convert it?
Code follows
Dim info As Object
Dim a1__()
Dim approv1, approv2, approv3, approv4, approv5, approv6,
approv7, approv8, approv9, approv10, approv11, approv12
Dim b1$, b2$, b3$, b4$, b5$, b6$, b7$, b8$, b9$, b10$, b11
$, b12$, b13$, b14$, b15$, b16$, b17$, b18$, b19$, b20$,
b21$, b22$, b23$, b24$, b25$, b26$, b27$, b28$, b29$, b30
$, b31$, b32$, b33$, b34$, b35$, b36$
Dim approval As Object
Public Sub MAIN()
ReDim a1__(12)
Dim msver$
Dim a1_$
Dim a2$
Dim a3$
Dim a4$
Dim a5$
Dim a6$
Dim a7$
Dim a8$
Dim a17$
Dim a11$
Dim a12$
Dim a15$
Dim a16$
Dim date1$
Dim x
Dim a15_
Dim a30$
Dim a31$
Dim ouo
Dim ouo_$
Dim p
Dim m1
Set info = WordBasic.DialogRecord.UserDialog(False)
approv1 = 0
approv2 = 0
approv3 = 0
approv4 = 0
approv5 = 0
approv6 = 0
approv7 = 0
approv8 = 0
approv9 = 0
approv10 = 0
approv11 = 0
approv12 = 0
b1$ = ""
b2$ = ""
b3$ = ""
b4$ = ""
b5$ = ""
b6$ = ""
b7$ = ""
b8$ = ""
b9$ = ""
b10$ = ""
b11$ = ""
b12$ = ""
b13$ = ""
b14$ = ""
b15$ = ""
b16$ = ""
b17$ = ""
b18$ = ""
b19$ = ""
b20$ = ""
b21$ = ""
b22$ = ""
b23$ = ""
b24$ = ""
b25$ = ""
b26$ = ""
b27$ = ""
b28$ = ""
b29$ = ""
b30$ = ""
b31$ = ""
b32$ = ""
b33$ = ""
b34$ = ""
b35$ = ""
b36$ = ""
Set approval = WordBasic.DialogRecord.UserDialog(False)
'Stop
'use template options for formating, not MSWord
WordBasic.WW7_ToolsOptionsAutoFormat PreserveStyles:=1,
ApplyStylesHeadings:=0, ApplyStylesLists:=1,
ApplyStylesOtherParas:=1, AdjustParaMarks:=1,
AdjustTabsSpaces:=1, AdjustEmptyParas:=1,
ReplaceQuotes:=1, ReplaceSymbols:=1, ReplaceBullets:=-1,
ApplyBulletedLists:=0, ReplaceOrdinals:=1,
ReplaceFractions:=1, ApplyBorders:=0,
ApplyNumberedLists:=0, ShowOptionsFor:=0
'check version
msver$ = WordBasic.[AppInfo$](2)
msver$ = Mid(msver$, 1, 1)
WordBasic.PrintStatusBar msver$
If msver$ < "7" Then
WordBasic.MsgBox "Sorry this template will not function
with MSWord Version " + msver$ + ". This template is
only compatible with MSWord 7 and MSWord 8.", "Microsoft
Word Version", 64
GoTo ender
End If
'On Error Resume Next
'Organizer .Rename, .Source = a1$ + "\NORMAL.DOT", .Name
= "FileOpen", '.NewName = "ScanProtFileOpen", .Tab = 3
'On Error Resume Next
'Organizer .Rename, .Source = a1$ + "\NORMAL.DOT", .Name
= "ShellOpen", '.NewName = "ScanProtShellOpen", .Tab = 3
'Goto new
a1_$ = WordBasic.[GetFormResult$]("title")
a2$ = WordBasic.[GetFormResult$]("prodname")
a3$ = WordBasic.[GetFormResult$]("number")
a4$ = WordBasic.[GetFormResult$]("numbsuff")
a5$ = WordBasic.[GetFormResult$]("date")
a6$ = WordBasic.[GetFormResult$]("rev")
a7$ = WordBasic.[GetFormResult$]("auth")
a8$ = WordBasic.[GetFormResult$]("authorg")
a17$ = WordBasic.[GetFormResult$]("authtit")
'If ExistingBookmark("proceng) Then
' a9$ = GetFormResult$("proceng")
' a10$ = GetFormResult$("procorg")
'End If
a11$ = WordBasic.[GetFormResult$]("mgr")
a12$ = WordBasic.[GetFormResult$]("mgrorg")
'a13$ = GetFormResult$("esh")
'a14$ = GetFormResult$("eshorg")
a15$ = WordBasic.[GetFormResult$]("type")
a16$ = WordBasic.[GetFormResult$]("authtitle")
If WordBasic.ExistingBookmark("de") Then
b1$ = WordBasic.[GetFormResult$]("de")
b2$ = WordBasic.[GetFormResult$]("deorg")
b3$ = WordBasic.[GetFormResult$]("detit")
approv1 = 1
End If
If WordBasic.ExistingBookmark("es") Then
b4$ = WordBasic.[GetFormResult$]("es")
b5$ = WordBasic.[GetFormResult$]("esorg")
b6$ = WordBasic.[GetFormResult$]("estit")
approv2 = 1
End If
If WordBasic.ExistingBookmark("hp") Then
b7$ = WordBasic.[GetFormResult$]("hp")
b8$ = WordBasic.[GetFormResult$]("hporg")
b9$ = WordBasic.[GetFormResult$]("hptit")
approv3 = 1
End If
If WordBasic.ExistingBookmark("rad") Then
b10$ = WordBasic.[GetFormResult$]("rad")
b11$ = WordBasic.[GetFormResult$]("radorg")
b12$ = WordBasic.[GetFormResult$]("radtit")
approv4 = 1
End If
If WordBasic.ExistingBookmark("class") Then
b13$ = WordBasic.[GetFormResult$]("class")
b14$ = WordBasic.[GetFormResult$]("classorg")
b15$ = WordBasic.[GetFormResult$]("classtit")
'Stop
WordBasic.PrintStatusBar b15$
approv5 = 1
End If
If WordBasic.ExistingBookmark("env") Then
b16$ = WordBasic.[GetFormResult$]("env")
b17$ = WordBasic.[GetFormResult$]("envorg")
b18$ = WordBasic.[GetFormResult$]("envtit")
approv6 = 1
End If
If WordBasic.ExistingBookmark("proceng") Then
b19$ = WordBasic.[GetFormResult$]("proceng")
b20$ = WordBasic.[GetFormResult$]("procorg")
b21$ = WordBasic.[GetFormResult$]("proctit")
approv7 = 1
End If
If WordBasic.ExistingBookmark("other") Then
b22$ = WordBasic.[GetFormResult$]("other")
b23$ = WordBasic.[GetFormResult$]("otherorg")
b24$ = WordBasic.[GetFormResult$]("othertit")
approv8 = 1
End If
If WordBasic.ExistingBookmark("owner") Then
b25$ = WordBasic.[GetFormResult$]("owner")
b26$ = WordBasic.[GetFormResult$]("ownerorg")
b27$ = WordBasic.[GetFormResult$]("ownertit")
approv9 = 1
End If
If WordBasic.ExistingBookmark("qeng") Then
b28$ = WordBasic.[GetFormResult$]("qeng")
b29$ = WordBasic.[GetFormResult$]("qengorg")
b30$ = WordBasic.[GetFormResult$]("qengtit")
approv10 = 1
End If
If WordBasic.ExistingBookmark("esh") Then
b31$ = WordBasic.[GetFormResult$]("esh")
b32$ = WordBasic.[GetFormResult$]("eshorg")
b33$ = WordBasic.[GetFormResult$]("eshtit")
approv11 = 1
End If
If WordBasic.ExistingBookmark("prodeng") Then
b34$ = WordBasic.[GetFormResult$]("prodeng")
b35$ = WordBasic.[GetFormResult$]("prodorg")
b36$ = WordBasic.[GetFormResult$]("prodtit")
approv12 = 1
End If
new_:
WordBasic.BeginDialog 790, 372, "Sandia Operating
Procedure"
WordBasic.GroupBox 20, 6, 337, 63, "Type of Procedure
(select one)"
WordBasic.OptionGroup "OptionGroup1"
WordBasic.OptionButton 30, 25, 162, 16, "Work
Instruction"
WordBasic.OptionButton 190, 25, 108,
16, "Equipment"
WordBasic.OptionButton 50, 45, 100,
16, "Analytical"
WordBasic.OptionButton 209, 45, 144,
16, "Administrative"
WordBasic.GroupBox 368, 7, 186, 44, "Mark Official
Use Only"
WordBasic.OptionGroup "OptionGroup2"
WordBasic.OptionButton 378, 26, 67, 16, "Yes"
WordBasic.OptionButton 458, 26, 64, 17, "No"
WordBasic.Text 78, 87, 71, 13, "Doc Title"
WordBasic.Text 58, 114, 95, 13, "Doc Number"
WordBasic.Text 269, 114, 7, 13, "-"
WordBasic.Text 405, 114, 41, 13, "Issue"
WordBasic.Text 572, 9, 65, 13, "Product:"
WordBasic.TextBox 572, 24, 160, 18, "prodname$"
WordBasic.Text 553, 114, 37, 13, "Date"
WordBasic.TextBox 161, 84, 567, 18, "Title$"
WordBasic.TextBox 159, 112, 104, 18, "number$"
WordBasic.TextBox 280, 112, 73, 18, "numbsuff$"
WordBasic.TextBox 455, 113, 77, 18, "rev$"
WordBasic.TextBox 597, 113, 132, 18, "Date1$"
WordBasic.Text 129, 150, 161, 13, "Initials and
Lastname"
WordBasic.Text 393, 150, 28, 13, "Org"
WordBasic.TextBox 130, 167, 239, 18, "auth$"
WordBasic.TextBox 395, 167, 92, 18, "authorg$"
WordBasic.TextBox 507, 167, 239, 18, "authtit$"
WordBasic.TextBox 130, 193, 239, 18, "mgr$"
WordBasic.TextBox 395, 193, 92, 18, "mgrorg$"
WordBasic.TextBox 507, 193, 239, 18, "authtitle$"
WordBasic.Text 67, 170, 51, 13, "Author"
WordBasic.Text 37, 196, 85, 13, "Auth. Sign."
WordBasic.Text 502, 150, 40, 13, "Title:"
WordBasic.Text 355, 232, 112, 14, "ES/H Reviews"
WordBasic.Text 131, 233, 145, 13, "Additional Reviews"
WordBasic.CheckBox 161, 248, 153, 16, "Area
Owner", "owner"
WordBasic.CheckBox 161, 264, 153, 16, "Design
Eng.", "de"
WordBasic.CheckBox 161, 280, 153, 16, "Product
Eng.", "prodeng"
WordBasic.CheckBox 161, 297, 129, 16, "Process
Eng.", "proceng"
WordBasic.CheckBox 161, 311, 153, 16, "Quality
Eng.", "qeng"
WordBasic.CheckBox 161, 327, 153,
16, "Classifier", "Class"
WordBasic.CheckBox 161, 343, 153, 16, "Other", "other"
WordBasic.CheckBox 367, 250, 175, 16, "Department
Rep.", "esh"
WordBasic.CheckBox 367, 265, 129, 16, "Safety", "es"
WordBasic.CheckBox 367, 280, 155, 16, "Health
Physics", "hp"
WordBasic.CheckBox 367, 295, 147, 16, "Ind.
Hygiene", "rad"
WordBasic.CheckBox 367, 310, 147,
16, "Environmental", "env"
WordBasic.OKButton 567, 293, 88, 21
WordBasic.EndDialog
Set info = WordBasic.CurValues.UserDialog
Set approval = WordBasic.CurValues.UserDialog
info.de = approv1
info.es = approv2
info.hp = approv3
info.rad = approv4
info.class = approv5
info.env = approv6
info.proceng = approv7
info.other = approv8
info.owner = approv9
info.qeng = approv10
info.esh = approv11
info.prodeng = approv12
'Stop
WordBasic.PrintStatusBar a15$
If a15$ = "WORK" Then
inf
ptionGroup1 = 0
End If
If a15$ = "EQUIPMENT" Then
inf
ptionGroup1 = 1
End If
If a15$ = "ANALYTICAL TEST" Then
inf
ptionGroup1 = 2
End If
If a15$ = "ADMINISTRATIVE" Then
inf
ptionGroup1 = 3
End If
'stop
'Print inf
ptionGroup1
info.Title$ = a1_$
info.prodname$ = a2$
info.Number$ = a3$
info.numbsuff$ = a4$
info.date1$ = a5$
WordBasic.PrintStatusBar date1$
'info.date$ = a5$
'rev$ = a6$
info.rev$ = a6$
info.auth$ = a7$
info.authorg$ = a8$
info.authtit$ = a17$
'info.proceng$ = a9$
'info.procorg$ = a10$
info.mgr$ = a11$
info.mgrorg$ = a12$
'info.esh$ = a13$
'info.eshorg$ = a14$
info.authtitle$ = a16$
inf
ptionGroup2 = 1
'stop
x = WordBasic.Dialog.UserDialog(info, -1)
If x = 0 Then
GoTo ender1
End If
'====Check entry for Product, Title, and Author====
'==on error display message and repeat dialog
'If a1$ = "" Then Goto misinfo
'If a1$ = "Title" Then Goto misinfo
'If a1$ = "0" Then Goto misinfo
'If a2$ = "" Then Goto misinfo
'If a2$ = "MCXXXX" Then Goto misinfo
'If a2$ = "0" Then Goto misinfo
'If a7$ = "JK Doe" Then Goto misinfo
'If a7$ = "" Then Goto misinfo
'If a7$ = "0" Then Goto misinfo
approv1 = info.de
'Stop
'Print appro1
approv2 = info.es
'Print n2
approv3 = info.hp
'Print n3
approv4 = info.rad
approv5 = info.class
approv6 = info.env
approv7 = info.proceng
approv8 = info.other
'Print n4
approv9 = info.owner
approv10 = info.qeng
approv11 = info.esh
approv12 = info.prodeng
a1__(1) = approv1
a1__(2) = approv2
a1__(3) = approv3
a1__(4) = approv4
a1__(5) = approv5
a1__(6) = approv6
a1__(7) = approv7
a1__(8) = approv8
a1__(9) = approv9
a1__(10) = approv10
a1__(11) = approv11
a1__(12) = approv12
'Stop
a1_$ = info.Title$
a2$ = info.prodname$
a3$ = info.Number$
a4$ = info.numbsuff$
a5$ = info.date1$
a6$ = info.rev$
a7$ = info.auth$
a8$ = info.authorg$
a17$ = info.authtit$
'a9$ = info.proceng$
'a10$ = info.procorg$
a11$ = info.mgr$
a12$ = info.mgrorg$
'a13$ = info.esh$
'a14$ = info.eshorg$
a15_ = inf
ptionGroup1
If a15_ = 0 Then
a15$ = "Work"
End If
If a15_ = 0 Then
a30$ = "Instruction"
Else
a30$ = "Operating Procedure"
End If
WordBasic.PrintStatusBar a30$
If a15_ = 0 Then
a31$ = "WI"
Else
a31$ = "OP"
End If
If a15_ = 1 Then
a15$ = "equipment"
End If
If a15_ = 2 Then
a15$ = "analytical"
End If
If a15_ = 3 Then
a15$ = "administrative"
End If
ouo = inf
ptionGroup2
If ouo = 0 Then
ouo_$ = "Official Use Only"
Else
ouo_$ = " "
End If
a16$ = info.authtitle$
a6$ = UCase(a6$)
WordBasic.PrintStatusBar a6$
a6$ = WordBasic.[LTrim$](a6$)
a6$ = WordBasic.[RTrim$](a6$)
If a6$ = "I" Or a6$ = "O" Or a6$ = "Q" Or a6$ = "X" Then
WordBasic.MsgBox "Dwg. issue of I,O,Q,and X are invalid
issues. All other information was saved. Correct the
issue. ", "Invalid Issue", 16
p = WordBasic.DocumentProtection()
WordBasic.PrintStatusBar p
If p = 0 Then
ender2
End If
GoTo new_
End If
'====This will fix the table for approvals===
fixtable
'===Set the formfield in the document
WordBasic.SetFormResult "title", a1_$, 1
WordBasic.SetFormResult "prodname", a2$, 1
WordBasic.SetFormResult "number", a3$, 1
WordBasic.SetFormResult "numbsuff", a4$, 1
WordBasic.SetFormResult "date", a5$, 1
WordBasic.SetFormResult "rev", a6$, 1
WordBasic.SetFormResult "auth", a7$, 1
WordBasic.SetFormResult "authorg", a8$, 1
WordBasic.SetFormResult "authtit", a17$, 1
'SetFormResult "proceng", a9$, 1
'SetFormResult "procorg", a10$, 1
WordBasic.SetFormResult "mgr", a11$, 1
WordBasic.SetFormResult "mgrorg", a12$, 1
'SetFormResult "esh", a13$, 1
'SetFormResult "eshorg", a14$, 1
WordBasic.SetFormResult "type", a15$, 1
WordBasic.SetFormResult "authtitle", a16$, 1
WordBasic.SetFormResult "type1", a30$, 1
WordBasic.SetFormResult "doctype", a31$, 1
WordBasic.SetFormResult "ouo", ouo_$, 1
'====check approval box====
If approv1 = 1 Then
approvalbox
End If
If approv2 = 1 Then
approvalbox
End If
If approv3 = 1 Then
approvalbox
End If
If approv4 = 1 Then
approvalbox
End If
If approv5 = 1 Then
approvalbox
End If
If approv6 = 1 Then
approvalbox
End If
If approv7 = 1 Then
approvalbox
End If
If approv8 = 1 Then
approvalbox
End If
If approv9 = 1 Then
approvalbox
End If
If approv10 = 1 Then
approvalbox
End If
If approv11 = 1 Then
approvalbox
End If
If approv12 = 1 Then
approvalbox
End If
'Stop
GoTo ender
'===display error message======
misinfo:
' error1 = MsgBox("Product, Title and Author
information is missing. 'This information must be
completed to use this Operating Procedure.", "Missing
Information", 64)
' Print error1
'Goto change
ender:
'Stop
WordBasic.PrintStatusBar a15_
If a15_ = 0 Then
GoTo work
End If
If a15_ = 1 Then
GoTo equip
End If
If a15_ = 2 Then
GoTo analytical
End If
If a15_ = 3 Then
GoTo administrative
End If
'===remove analytical, equiptment and administrative
sections=====
work:
'EditBookmark .Name = "equipstart", .Goto
WordBasic.WW7_EditGoTo "equipstart"
WordBasic.CharRight 1, 1
WordBasic.ExtendSelection
WordBasic.WW7_EditGoTo "procstart"
WordBasic.WW6_EditClear
WordBasic.WW7_EditGoTo "procend"
WordBasic.CharRight 1, 1
WordBasic.ExtendSelection
WordBasic.WW7_EditGoTo "chngstart"
WordBasic.WW6_EditClear
GoTo ender1
'===remove analytical, process, and administrative
sections=====
equip:
'EditBookmark .Name = "procstart", .Goto
WordBasic.WW7_EditGoTo "equipend"
WordBasic.CharRight 1, 1
WordBasic.ExtendSelection
WordBasic.WW7_EditGoTo "chngstart"
WordBasic.WW6_EditClear
If a15_ = 1 Then
GoTo fixtoc
End If
GoTo ender1
'===remove equiptment, process and administrative
sections=====
analytical:
WordBasic.WW7_EditGoTo "equipstart"
WordBasic.CharRight 1, 1
WordBasic.ExtendSelection
WordBasic.WW7_EditGoTo "analystart"
WordBasic.WW6_EditClear
WordBasic.WW7_EditGoTo "analyend"
WordBasic.CharRight 1, 1
WordBasic.ExtendSelection
WordBasic.WW7_EditGoTo "chngstart"
WordBasic.WW6_EditClear
GoTo ender1
'===remove equiptment, analytical and process
sections=====
administrative:
WordBasic.WW7_EditGoTo "equipstart"
WordBasic.CharRight 1, 1
WordBasic.ExtendSelection
WordBasic.WW7_EditGoTo "adminstart"
WordBasic.WW6_EditClear
If a15_ = 3 Then
GoTo fixtoc
End If
GoTo ender1
'======fix equipment and admin table of contents
fixtoc:
WordBasic.EditFind Find:="Table Of Contents",
Direction:=0, MatchCase:=0, WholeWord:=0,
PatternMatch:=0, SoundsLike:=0, Format:=0, Wrap:=1
WordBasic.CharRight 1
WordBasic.InsertPara
WordBasic.InsertTableOfContents Outline:=0, From:="",
To:="", AddedStyles:="
appendix,2,OP_Heading1,1,OP_Heading2,2,OP_Heading3,3",
RightAlignPageNumbers:=1
ender1:
''ScreenUpdating 0
WordBasic.EditBookmark Name:="bkafterupdate", SortBy:=0,
Add:=1
WordBasic.EditSelectAll
WordBasic.UpdateFields
'update reference in Header
WordBasic.WW7_EditGoTo Destination:="s2"
WordBasic.ViewHeader
WordBasic.EditSelectAll
WordBasic.UpdateFields
WordBasic.CloseViewHeaderFooter
WordBasic.WW7_EditGoTo Destination:="bkafterupdate"
ender2
m1 = WordBasic.MsgBox("Setup for your document is
complete and document is locked. Changes are made from
the OP_Template menu on the menu bar. Select OK and
start entering your information.", "Document setup", 64)
WordBasic.PrintStatusBar m1
End Sub
Private Sub ender2()
Dim count_
Dim s1
Dim s2
Dim slast
Dim ii
'this sets up the variables for finding and protecting
section within document
count_ = 1
WordBasic.StartOfDocument
WordBasic.EditFind Find:="^b", Direction:=0,
MatchCase:=0, WholeWord:=0, PatternMatch:=0,
SoundsLike:=0, Format:=0, Wrap:=0
While WordBasic.EditFindFound()
count_ = count_ + 1
WordBasic.EditFind
Wend
'Stop
WordBasic.PrintStatusBar count_
s1 = 1
s2 = count_ - 1
slast = count_
WordBasic.PrintStatusBar s1
'Print s2
WordBasic.PrintStatusBar slast
For ii = 1 To slast
WordBasic.ToolsProtectSection Section:=ii, Protect:=0
Next ii
WordBasic.ToolsProtectSection Section:=s1, Protect:=1
WordBasic.ToolsProtectSection Section:=slast, Protect:=1
'OnError Goto ender
WordBasic.ToolsProtectDocument DocumentPassword:="rich",
NoReset:=1, Type:=2
WordBasic.WW7_EditGoTo Destination:="s2"
'If ExistingBookmark("procstart") Then
' 'EditGoTo "procstart"
'End If
'If ExistingBookmark("equipstart") Then
' 'EditGoTo "equipstart"
'End If
'If ExistingBookmark("analystart") Then
' EditGoTo "analystart"
'End If
End Sub
Private Function mydlg(contid$, action, supp)
If approv1 = 0 Then
WordBasic.DlgVisible "DlgText1", 0
WordBasic.DlgVisible "de$", 0
WordBasic.DlgVisible "deorg$", 0
WordBasic.DlgVisible "detit$", 0
End If
If approv2 = 0 Then
WordBasic.DlgVisible "DlgText2", 0
WordBasic.DlgVisible "es$", 0
WordBasic.DlgVisible "esorg$", 0
WordBasic.DlgVisible "estit$", 0
End If
If approv3 = 0 Then
WordBasic.DlgVisible "DlgText3", 0
WordBasic.DlgVisible "hp$", 0
WordBasic.DlgVisible "hporg$", 0
WordBasic.DlgVisible "hptit$", 0
End If
If approv4 = 0 Then
WordBasic.DlgVisible "DlgText4", 0
WordBasic.DlgVisible "rad$", 0
WordBasic.DlgVisible "radorg$", 0
WordBasic.DlgVisible "radtit$", 0
End If
If approv5 = 0 Then
WordBasic.DlgVisible "DlgText5", 0
WordBasic.DlgVisible "Class$", 0
WordBasic.DlgVisible "classorg$", 0
WordBasic.DlgVisible "classtit$", 0
End If
If approv6 = 0 Then
WordBasic.DlgVisible "DlgText6", 0
WordBasic.DlgVisible "env$", 0
WordBasic.DlgVisible "envorg$", 0
WordBasic.DlgVisible "envtit$", 0
End If
If approv7 = 0 Then
WordBasic.DlgVisible "DlgText7", 0
WordBasic.DlgVisible "proceng$", 0
WordBasic.DlgVisible "procorg$", 0
WordBasic.DlgVisible "proctit$", 0
End If
If approv8 = 0 Then
WordBasic.DlgVisible "DlgText8", 0
WordBasic.DlgVisible "other$", 0
WordBasic.DlgVisible "otherorg$", 0
WordBasic.DlgVisible "othertit$", 0
End If
If approv9 = 0 Then
WordBasic.DlgVisible "DlgText9", 0
WordBasic.DlgVisible "owner$", 0
WordBasic.DlgVisible "ownerorg$", 0
WordBasic.DlgVisible "ownertit$", 0
End If
If approv10 = 0 Then
WordBasic.DlgVisible "DlgText10", 0
WordBasic.DlgVisible "qeng$", 0
WordBasic.DlgVisible "qengorg$", 0
WordBasic.DlgVisible "qengtit$", 0
End If
If approv11 = 0 Then
WordBasic.DlgVisible "DlgText11", 0
WordBasic.DlgVisible "esh$", 0
WordBasic.DlgVisible "eshorg$", 0
WordBasic.DlgVisible "eshtit$", 0
End If
If approv12 = 0 Then
WordBasic.DlgVisible "DlgText12", 0
WordBasic.DlgVisible "prodeng$", 0
WordBasic.DlgVisible "prodorg$", 0
WordBasic.DlgVisible "prodtit$", 0
End If
' DlgVisible "ownertit$", 0
' DlgVisible "detit$", 0
' DlgVisible "qengtit$", 0
' DlgVisible "proctit$", 0
' DlgVisible "classtit$", 0
approv1 = 2
approv2 = 2
approv3 = 2
approv4 = 2
approv5 = 2
approv6 = 2
approv7 = 2
approv8 = 2
approv9 = 2
approv10 = 2
approv11 = 2
approv12 = 2
End Function
Private Sub approvalbox()
Dim x
WordBasic.BeginDialog 790, 368, "Procedure
Reviews", "AutoNew.mydlg"
WordBasic.Text 82, 9, 77, 12, "Reviewer:"
WordBasic.Text 176, 10, 167, 12, "Initials and
Lastname:"
WordBasic.Text 386, 9, 33, 12, "Org:"
WordBasic.Text 517, 10, 67, 12, "Job title:"
WordBasic.Text 76, 34, 95, 12, "Area
Owner:", "DlgText9"
WordBasic.TextBox 176, 32, 175, 19, "owner$"
WordBasic.TextBox 388, 31, 92, 19, "ownerorg$"
WordBasic.TextBox 509, 31, 175, 18, "ownertit$"
WordBasic.Text 75, 59, 93, 12, "Design
Eng:", "DlgText1"
WordBasic.TextBox 176, 57, 175, 19, "de$"
WordBasic.TextBox 388, 56, 92, 19, "deorg$"
WordBasic.TextBox 509, 56, 175, 19, "detit$"
WordBasic.Text 68, 83, 100, 13, "Product
Eng:", "DlgText12"
WordBasic.TextBox 176, 81, 175, 19, "prodeng$"
WordBasic.TextBox 388, 80, 92, 19, "prodorg$"
WordBasic.TextBox 509, 80, 175, 19, "prodtit$"
WordBasic.Text 70, 106, 101, 15, "Process
Eng:", "DlgText7"
WordBasic.TextBox 176, 105, 175, 19, "proceng$"
WordBasic.TextBox 388, 104, 92, 19, "procorg$"
WordBasic.TextBox 509, 104, 175, 19, "proctit$"
WordBasic.Text 74, 131, 93, 14, "Quality
Eng:", "DlgText10"
WordBasic.TextBox 176, 129, 175, 19, "qeng$"
WordBasic.TextBox 388, 128, 92, 19, "qengorg$"
WordBasic.TextBox 509, 128, 175, 19, "qengtit$"
WordBasic.Text 97, 157, 75,
12, "Classifier:", "DlgText5"
WordBasic.TextBox 176, 153, 175, 19, "Class$"
WordBasic.TextBox 388, 152, 92, 19, "classorg$"
WordBasic.TextBox 509, 153, 175, 19, "classtit$"
WordBasic.Text 118, 179, 48, 12, "Other:", "DlgText8"
WordBasic.TextBox 176, 176, 175, 19, "other$"
WordBasic.TextBox 388, 176, 92, 19, "otherorg$"
WordBasic.TextBox 509, 176, 175, 19, "othertit$"
WordBasic.Text 113, 237, 55, 11, "Safety:", "DlgText2"
WordBasic.TextBox 174, 233, 175, 18, "es$"
WordBasic.TextBox 386, 232, 92, 18, "esorg$"
WordBasic.TextBox 509, 232, 175, 18, "estit$"
WordBasic.Text 41, 213, 125, 11, "ES/H Dept
Rep.", "DlgText11"
WordBasic.TextBox 174, 209, 175, 18, "esh$"
WordBasic.TextBox 386, 208, 92, 18, "eshorg$"
WordBasic.TextBox 507, 208, 175, 18, "eshtit$"
WordBasic.Text 53, 261, 119, 11, "Health
Physics:", "DlgText3"
WordBasic.TextBox 176, 257, 175, 18, "hp$"
WordBasic.TextBox 388, 256, 92, 18, "hporg$"
WordBasic.TextBox 509, 256, 175, 18, "hptit$"
WordBasic.Text 29, 286, 143, 15, "Industrial
Hygiene:", "DlgText4"
WordBasic.TextBox 176, 282, 175, 18, "rad$"
WordBasic.TextBox 388, 281, 92, 18, "radorg$"
WordBasic.TextBox 509, 280, 175, 18, "radtit$"
WordBasic.Text 56, 309, 113,
11, "Environmental:", "DlgText6"
WordBasic.TextBox 176, 306, 175, 19, "env$"
WordBasic.TextBox 388, 305, 92, 19, "envorg$"
WordBasic.TextBox 509, 304, 175, 19, "envtit$"
WordBasic.OKButton 286, 337, 88, 19
WordBasic.CancelButton 410, 336, 88, 19
WordBasic.EndDialog
Set info = WordBasic.CurValues.UserDialog
Set approval = WordBasic.CurValues.UserDialog
approval.de$ = b1$
'Stop
WordBasic.PrintStatusBar b1$
approval.deorg$ = b2$
If b3$ = "" Then
b3$ = "Design Eng."
End If
approval.detit$ = b3$
approval.es$ = b4$
approval.esorg$ = b5$
If b6$ = "" Then
b6$ = "Safety"
End If
approval.estit$ = b6$
approval.hp$ = b7$
approval.hporg$ = b8$
If b9$ = "" Then
b9$ = "Health Physics"
End If
approval.hptit$ = b9$
approval.rad$ = b10$
approval.radorg$ = b11$
If b12$ = "" Then
b12$ = "Industrial Hygiene"
End If
approval.radtit$ = b12$
approval.class$ = b13$
approval.classorg$ = b14$
'Stop
WordBasic.PrintStatusBar b15$
If b15$ = "" Then
b15$ = "Classifier"
End If
approval.classtit$ = b15$
approval.env$ = b16$
approval.envorg$ = b17$
If b18$ = "" Then
b18$ = "Environmental"
End If
approval.envtit$ = b18$
approval.proceng$ = b19$
approval.procorg$ = b20$
If b21$ = "" Then
b21$ = "Process Eng"
End If
approval.proctit$ = b21$
approval.other$ = b22$
approval.otherorg$ = b23$
If b24$ = "" Then
b24$ = "Other"
End If
approval.othertit$ = b24$
approval.owner$ = b25$
approval.ownerorg$ = b26$
If b27$ = "" Then
b27$ = "Area Owner"
End If
approval.ownertit$ = b27$
approval.qeng$ = b28$
approval.qengorg$ = b29$
If b30$ = "" Then
b30$ = "Quality Eng."
End If
approval.qengtit$ = b30$
approval.esh$ = b31$
approval.eshorg$ = b32$
If b33$ = "" Then
b33$ = "ES/H Dept Rep."
End If
approval.eshtit$ = b33$
approval.prodeng$ = b34$
approval.prodorg$ = b35$
If b36$ = "" Then
b36$ = "Product Eng."
End If
approval.prodtit$ = b36$
x = WordBasic.Dialog.UserDialog(approval, -1)
If x = 0 Then
GoTo ender
End If
'Stop
b1$ = approval.de$
WordBasic.PrintStatusBar b1$
b2$ = approval.deorg$
b3$ = approval.detit$
b4$ = approval.es$
b5$ = approval.esorg$
b6$ = approval.estit$
b7$ = approval.hp$
b8$ = approval.hporg$
b9$ = approval.hptit$
b10$ = approval.rad$
b11$ = approval.radorg$
b12$ = approval.radtit$
b13$ = approval.class$
b14$ = approval.classorg$
b15$ = approval.classtit$
b16$ = approval.env$
b17$ = approval.envorg$
b18$ = approval.envtit$
b19$ = approval.proceng$
b20$ = approval.procorg$
b21$ = approval.proctit$
b22$ = approval.other$
b23$ = approval.otherorg$
b24$ = approval.othertit$
b25$ = approval.owner$
b26$ = approval.ownerorg$
b27$ = approval.ownertit$
b28$ = approval.qeng$
b29$ = approval.qengorg$
b30$ = approval.qengtit$
b31$ = approval.esh$
b32$ = approval.eshorg$
b33$ = approval.eshtit$
b34$ = approval.prodeng$
b35$ = approval.prodorg$
b36$ = approval.prodtit$
'Stop
WordBasic.PrintStatusBar b1$
If WordBasic.ExistingBookmark("de") Then
WordBasic.SetFormResult "de", b1$, 1
WordBasic.SetFormResult "deorg", b2$, 1
WordBasic.SetFormResult "detit", b3$, 1
End If
If WordBasic.ExistingBookmark("es") Then
WordBasic.SetFormResult "es", b4$, 1
WordBasic.SetFormResult "esorg", b5$, 1
WordBasic.SetFormResult "estit", b6$, 1
End If
If WordBasic.ExistingBookmark("hp") Then
WordBasic.SetFormResult "hp", b7$, 1
WordBasic.SetFormResult "hporg", b8$, 1
WordBasic.SetFormResult "hptit", b9$, 1
End If
If WordBasic.ExistingBookmark("rad") Then
WordBasic.SetFormResult "rad", b10$, 1
WordBasic.SetFormResult "radorg", b11$, 1
WordBasic.SetFormResult "radtit", b12$, 1
End If
If WordBasic.ExistingBookmark("class") Then
WordBasic.SetFormResult "class", b13$, 1
WordBasic.SetFormResult "classorg", b14$, 1
WordBasic.SetFormResult "classtit", b15$, 1
End If
If WordBasic.ExistingBookmark("env") Then
WordBasic.SetFormResult "env", b16$, 1
WordBasic.SetFormResult "envorg", b17$, 1
WordBasic.SetFormResult "envtit", b18$, 1
End If
If WordBasic.ExistingBookmark("proceng") Then
WordBasic.SetFormResult "proceng", b19$, 1
WordBasic.SetFormResult "procorg", b20$, 1
WordBasic.SetFormResult "proctit", b21$, 1
End If
If WordBasic.ExistingBookmark("other") Then
WordBasic.SetFormResult "other", b22$, 1
WordBasic.SetFormResult "otherorg", b23$, 1
WordBasic.SetFormResult "othertit", b24$, 1
End If
If WordBasic.ExistingBookmark("owner") Then
WordBasic.SetFormResult "owner", b25$, 1
WordBasic.SetFormResult "ownerorg", b26$, 1
WordBasic.SetFormResult "ownertit", b27$, 1
End If
If WordBasic.ExistingBookmark("qeng") Then
WordBasic.SetFormResult "qeng", b28$, 1
WordBasic.SetFormResult "qengorg", b29$, 1
WordBasic.SetFormResult "qengtit", b30$, 1
End If
If WordBasic.ExistingBookmark("esh") Then
WordBasic.SetFormResult "esh", b31$, 1
WordBasic.SetFormResult "eshorg", b32$, 1
WordBasic.SetFormResult "eshtit", b33$, 1
End If
If WordBasic.ExistingBookmark("prodeng") Then
WordBasic.SetFormResult "prodeng", b34$, 1
WordBasic.SetFormResult "prodorg", b35$, 1
WordBasic.SetFormResult "prodtit", b36$, 1
End If
ender:
End Sub
''Dim Shared a1(11)
Private Sub fixtable()
compress
End Sub
Private Sub compress()
Dim num
Dim i
Dim aa1
Dim numt
Dim num1
Dim m
Dim mm
Dim nn
Dim aa1_$
Dim n2
Dim bb1$
Dim ab1$
ReDim bkmrk__$(42)
ReDim bkmrk1__$(42)
ReDim title__$(42)
ReDim title1__$(42)
'***************************************
'this macro compresses the op table down to just the
signatures required
'
'its name is cmprstable
'****************************************
'time is 2:45
'date is 1/23/96
'Stop
WordBasic.ToolsUnprotectDocument DocumentPassword:="rich"
'set cursor locations for return at end of program
WordBasic.EditBookmark Name:="opprotect", SortBy:=0,
Add:=1
'Stop
num = 0
For i = 1 To 12
aa1 = a1__(i)
WordBasic.PrintStatusBar aa1
If aa1 = 1 Then
num = num + 1
End If
Next i
'Stop
'num is the number of discretionary signatures
WordBasic.PrintStatusBar num
'numt is number of entries in table
numt = num + 2
num1 = numt / 2
num1 = num1 + 0.5
num1 = WordBasic.Int(num1)
'num1 is the number of rows to add in the table
WordBasic.PrintStatusBar num1
'to initialize the bookmark names
bkmrk__$(1) = "auth"
bkmrk__$(2) = "authorg"
bkmrk__$(3) = "authtit"
bkmrk__$(4) = "de"
bkmrk__$(5) = "deorg"
bkmrk__$(6) = "detit"
bkmrk__$(7) = "es"
bkmrk__$(8) = "esorg"
bkmrk__$(9) = "estit"
bkmrk__$(10) = "hp"
bkmrk__$(11) = "hporg"
bkmrk__$(12) = "hptit"
bkmrk__$(13) = "rad"
bkmrk__$(14) = "radorg"
bkmrk__$(15) = "radtit"
bkmrk__$(16) = "class"
bkmrk__$(17) = "classorg"
bkmrk__$(18) = "classtit"
bkmrk__$(19) = "env"
bkmrk__$(20) = "envorg"
bkmrk__$(21) = "envtit"
bkmrk__$(22) = "proceng"
bkmrk__$(23) = "procorg"
bkmrk__$(24) = "proctit"
bkmrk__$(25) = "other"
bkmrk__$(26) = "otherorg"
bkmrk__$(27) = "othertit"
bkmrk__$(28) = "owner"
bkmrk__$(29) = "ownerorg"
bkmrk__$(30) = "ownertit"
bkmrk__$(31) = "qeng"
bkmrk__$(32) = "qengorg"
bkmrk__$(33) = "qengtit"
bkmrk__$(34) = "esh"
bkmrk__$(35) = "eshorg"
bkmrk__$(36) = "eshtit"
bkmrk__$(37) = "prodeng"
bkmrk__$(38) = "prodorg"
bkmrk__$(39) = "prodtit"
bkmrk__$(40) = "mgr"
bkmrk__$(41) = "mgrorg"
bkmrk__$(42) = "authtitle"
title__$(1) = ""
title__$(2) = ""
title__$(3) = "Author"
title__$(4) = ""
title__$(5) = ""
title__$(6) = "Design Engineer "
title__$(7) = ""
title__$(8) = ""
title__$(9) = "Safety:"
title__$(10) = ""
title__$(11) = ""
title__$(12) = "Health Phy:"
title__$(13) = ""
title__$(14) = ""
title__$(15) = "Ind. Hyg:"
title__$(16) = ""
title__$(17) = ""
title__$(18) = "Classifier"
title__$(19) = ""
title__$(20) = ""
title__$(21) = "Env:"
title__$(22) = ""
title__$(23) = ""
title__$(24) = "Process Engineer"
title__$(25) = ""
title__$(26) = ""
title__$(27) = "Other"
title__$(28) = ""
title__$(29) = ""
title__$(30) = "Area Owner"
title__$(31) = ""
title__$(32) = ""
title__$(33) = "Quality Engineer"
title__$(34) = ""
title__$(35) = ""
title__$(36) = "Dept. ES&H"
title__$(37) = ""
title__$(38) = ""
title__$(39) = "Product Engineer"
title__$(40) = ""
title__$(41) = ""
title__$(42) = ""
'Stop
'now to build working titles and bookmarks
'for the required signatures
For i = 1 To 3
'stop
WordBasic.PrintStatusBar i
bkmrk1__$(i) = bkmrk__$(i)
WordBasic.PrintStatusBar bkmrk1__$(i)
title1__$(i) = title__$(i)
WordBasic.PrintStatusBar title1__$(i)
Next i
'Stop
m = 3
For i = 1 To 12
aa1 = a1__(i)
WordBasic.PrintStatusBar i, aa1, m
If aa1 = 1 Then
m = m + 1
WordBasic.PrintStatusBar m
mm = i * 3
bkmrk1__$(m) = bkmrk__$(mm + 1)
bkmrk1__$(m + 1) = bkmrk__$(mm + 2)
bkmrk1__$(m + 2) = bkmrk__$(mm + 3)
title1__$(m) = title__$(mm + 1)
title1__$(m + 1) = title__$(mm + 2)
title1__$(m + 2) = title__$(mm + 3)
WordBasic.PrintStatusBar bkmrk1__$(m), bkmrk1__$(m +
1), bkmrk1__$(m + 2), title1__$(m), title1__$(m + 1),
title1__$(m + 2)
m = m + 2
End If
Next i
'Stop
WordBasic.PrintStatusBar m
m = m + 1
'for the last cell
bkmrk1__$(m) = bkmrk__$(40)
bkmrk1__$(m + 1) = bkmrk__$(41)
bkmrk1__$(m + 2) = bkmrk__$(42)
title1__$(m) = title__$(40)
title1__$(m + 1) = title__$(41)
title1__$(m + 2) = title__$(42)
m = m + 1
'stop
For i = 1 To m
WordBasic.PrintStatusBar bkmrk1__$(i), title1__$(i)
Next i
'Stop
If num1 = 1 Then
GoTo onerow
End If
'EditBookmark .Name = "tabend", .Add
WordBasic.WW7_EditGoTo Destination:="rowstart"
'LineDown
WordBasic.TableSelectRow
WordBasic.ExtendSelection
WordBasic.EndOfColumn 1
'EditGoTo "tabend"
'TableDeleteRow
'TableSelectRow
'ExtendSelection
'EndOfColumn 1
'EditGoTo "rowend"
WordBasic.EditCopy
WordBasic.LineDown
For i = 1 To num1 - 1
WordBasic.EditPaste
Next i
onerow:
WordBasic.WW7_EditGoTo Destination:="rowstart"
WordBasic.TableSelectTable
WordBasic.WW6_EditClear
WordBasic.WW7_EditGoTo Destination:="rowstart"
WordBasic.LineDown
nn = 0
'Stop
For i = 1 To m Step 3
'stop
WordBasic.PrintStatusBar i
aa1_$ = bkmrk1__$(i)
WordBasic.PrintStatusBar aa1_$
WordBasic.InsertFormField Name:=aa1_$, Enable:=0,
TextType:=0, TextWidth:="15", TextDefault:="",
TextFormat:="", Type:=0
WordBasic.Insert ", Org "
aa1_$ = bkmrk1__$(i + 1)
WordBasic.InsertFormField Name:=aa1_$, Enable:=0,
TextType:=0, TextWidth:="9", TextDefault:="",
TextFormat:="", Type:=0
WordBasic.NextCell
WordBasic.NextCell
WordBasic.Insert "Date"
WordBasic.NextCell
WordBasic.NextCell
'NextCell
'CharLeft 1
nn = nn + 1
n2 = nn Mod 2
WordBasic.PrintStatusBar n2
'to skip the next 16 cells
If n2 = 0 Then
'NextCell
'need to insert title here
bb1$ = title1__$(i - 1)
'Stop
WordBasic.PrintStatusBar bb1$
aa1_$ = bkmrk1__$(i - 1)
WordBasic.PrintStatusBar aa1_$
WordBasic.InsertFormField Name:=aa1_$, Enable:=0,
TextType:=0, TextWidth:="27", TextDefault:=bb1$,
TextFormat:="", Type:=0
WordBasic.NextCell
WordBasic.NextCell
WordBasic.NextCell
WordBasic.NextCell
'need to insert title here
ab1$ = title1__$(i + 2)
aa1_$ = bkmrk1__$(i + 2)
WordBasic.PrintStatusBar aa1_$
WordBasic.InsertFormField Name:=aa1_$, Enable:=0,
TextType:=0, TextWidth:="27", TextDefault:=ab1$,
TextFormat:="", Type:=0
''Insert ab1$
WordBasic.NextCell
WordBasic.NextCell
WordBasic.NextCell
'End of Row
WordBasic.PrintStatusBar i, m
If i = m - 1 Then
GoTo Done
End If
WordBasic.NextCell
WordBasic.NextCell
WordBasic.NextCell
WordBasic.NextCell
WordBasic.NextCell
WordBasic.NextCell
WordBasic.NextCell
WordBasic.NextCell
WordBasic.NextCell
Done:
'CharLeft 1
End If
'Stop
Next i
'Stop
WordBasic.EditBookmark Name:="mgr", GoTo:=1
'Stop
WordBasic.LineDown
WordBasic.EndOfRow
WordBasic.NextCell
WordBasic.EditBookmark Name:="mgr", GoTo:=1
WordBasic.LineDown
If n2 <> 0 Then
WordBasic.InsertFormField Name:="authtitle",
Enable:=0, TextType:=0, TextWidth:="0", TextDefault:="",
TextFormat:="", Type:=0
End If
WordBasic.LineDown
WordBasic.Insert "Authorizing Signature"
'Stop
'add author under authortitle
If num1 <> 1 Then
WordBasic.EditBookmark Name:="authtit", GoTo:=1
' TableSelectRow
' TableInsertRow .NumRows = ""
' LineDown 1
WordBasic.TableSelectRow
WordBasic.EditCopy
WordBasic.WW6_EditClear
' LineUp 1
WordBasic.EditPaste
' LineDown 1
' TableSelectRow
' TableDeleteRow
WordBasic.WW7_EditGoTo Destination:="rowend"
WordBasic.LineUp
' Modified on 19 April 2002 to fix Office 2000
problem
' The rowend bookmark is outside the table, when a
lineup is executed,
' the cursor goes to the last column of the row above
and not outside the table
' Therefore, the rowend goes in the wrong place, and
can be deleted.
'
' Add a CharRight after performing the Lineup
' else use old command
If Mid(WordBasic.[AppInfo$](2), 1, 1) = "9" Then
WordBasic.CharRight 1
End If
' end of modified code
WordBasic.EditBookmark Name:="rowend", Add:=1
Else
WordBasic.EditBookmark Name:="authtit", GoTo:=1
WordBasic.LineDown
WordBasic.Insert "Author"
End If
If num1 = 1 Then
GoTo ender
End If
WordBasic.EditBookmark Name:="authtit", GoTo:=1
WordBasic.LineDown
WordBasic.Insert "Author"
ender:
WordBasic.PrintStatusBar "end of compress"
End Sub
