Single-Form Generator

A Word document that creates a new Word document and populates specific fields.

Source Code

Place this code in the ThisDocument class.

Private Const FF_COUNT As Long = 72
'Used to populate data array'TODO: arrange this list according to location of fields on target formEnum dataArrayEnumszerodeviceSNtimeTakenticketNorepairCycleperformedBycuvetteLot01cuvetteExpDate01labelRangeLow01labelRangeHigh01adjustedRangeLow01adjustedRangeHigh01controlsLot01controlsExpDate01lithiumYes01AAYes01USBYes01ACYes01first01second01third01fourth01fifth01sixth01seventh01eighth01nineth01tenth01cuvetteLot02cuvetteExpDate02labelRangeLow02labelRangeHigh02adjustedRangeLow02adjustedRangeHigh02controlsLot02controlsExpDate02lithiumYes02AAYes02USBYes02ACYes02first02second02third02fourth02fifth02sixth02seventh02eighth02nineth02tenth02cuvetteLot03cuvetteExpDate03labelRangeLow03labelRangeHigh03adjustedRangeLow03adjustedRangeHigh03controlsLot03controlsExpDate03lithiumYes03AAYes03USBYes03ACYes03first03second03third03fourth03fifth03sixth03seventh03eighth03nineth03tenth03commentsCheckBoxEnd Enum
Sub generateForm_Click()' Nolan Manteufel' nolan.manteufel@gmail.com' 16JUL2020
'VariablesDim dataArray(FF_COUNT) As StringDim arrayIndex As Long
'Initialize array to N/AFor arrayIndex = 1 To FF_COUNT dataArray(arrayIndex) = "N/A"Next
'generator documentDim gDoc As DocumentSet gDoc = ActiveDocumentDim gDocName As String: gDocName = gDoc.Name
'new documentDim nDoc As DocumentDim nDocName As String
'UserDim macroUser As StringmacroUser = Environ$("username")macroUser = LCase(macroUser)
'ComputerDim macroComputer As StringmacroComputer = Environ$("computername")macroComputer = LCase(macroComputer)
'DatetimeDim timeOnly As StringDim dateOnly As StringDim dateTime As StringtimeOnly = Format(Time, "hhmmss")dateOnly = Format(Date, "yyyymmdd")dateTime = dateOnly & timeOnly
Dim field, nDim modify As IntegerDim answer As Integer
Dim FFs As FormFieldsDim ff As formField
Dim templatePath As String: templatePath = "O:\doc\"Dim templateName As String: templateName = "no template found."
'''' Y:\ENG - Engineering Files\860 - Software Source Code\INF VBA\INF200''''' USED FOR DEBUGGING'''modify = MsgBox("May the VBA modify the form fields?", vbCritical + vbYesNo)''''''If modify = vbYes Then''' answer = MsgBox("Set text equal to bookmark?", vbQuestion + vbYesNo, "TextBox Form Fields")''' If answer = vbYes Then''' For Each formField In gDoc.FormFields''' If formField.Type = wdFieldFormTextInput Then''' text = formField.Name''' formField.result = text''' End If''' Next''' Else''' For Each formField In gDoc.FormFields''' If formField.Type = wdFieldFormTextInput Then''' formField.result = vbNullString''' End If''' Next''' End If'''Else''' ' DO NOT CHANGE FORM'''End If
'Determine what form to createSet field = gDoc.FormFields("form").DropDownn = field.ValuetemplateName = field.ListEntries(n).Name
'Select templateSelect Case templateNameCase "APPROVED, Extensive Testing 30" If (macroUser = "nmanteufel" Or macroUser = "jlopez" Or macroUser = "kficke" Or macroUser = "rmunoz") Then 'Use macro-enabled template templatePath = "O:\doc\INF.200.030.01 UltraCrit Extensive Testing Form 30.docm" Else 'Use normal template templatePath = "S:\APPROVED DOCUMENTS\Instruments\INF\INF.200.030.01 UltraCrit Extensive Testing Form 30.docm" End If 'Prompt for confirmation answer = MsgBox("Click OK to create a new INF.200.030, Extensive Testing 30.", vbOKCancel + vbQuestion, "Form Generator")''Case "DRAFT, Extensive Testing 30"'' 'Select template'' templatePath = "O:\doc\UC30.dotm"'' 'Prompt for confirmation'' answer = MsgBox("Click OK to create a new DRAFT INF.200.030, Extensive Testing 30.", vbOKCancel + vbQuestion, "Form Generator")''Case "DRAFT, Extensive Testing 60"'' 'Select template'' templatePath = "O:\doc\UC60.dotm"'' 'Prompt for confirmation'' answer = MsgBox("Click OK to create a new DRAFT INF.200.060, Extensive Testing 60.", vbOKCancel + vbQuestion, "Form Generator")Case Else MsgBox "Unable to create this form: " & templateName, vbCriticalEnd Select
'Create new form?If answer = vbOK Then 'Populate data array ... array indexing is determined by the order of enumeration in: Enum dataArrayEnums '' OVERVIEW INFORMATION dataArray(performedBy) = gDoc.FormFields("performedBy").result dataArray(ticketNo) = gDoc.FormFields("ticketNo").result dataArray(deviceSN) = gDoc.FormFields("deviceSN").result dataArray(repairCycle) = gDoc.FormFields("repairCycle").result '' TEST SET 1 dataArray(cuvetteLot01) = gDoc.FormFields("cuvetteLot01").result dataArray(cuvetteExpDate01) = gDoc.FormFields("cuvetteExpDate01").result dataArray(controlsLot01) = gDoc.FormFields("controlsLot01").result dataArray(controlsExpDate01) = gDoc.FormFields("controlsExpDate01").result dataArray(labelRangeLow01) = gDoc.FormFields("labelRangeLow01").result dataArray(labelRangeHigh01) = gDoc.FormFields("labelRangeHigh01").result dataArray(adjustedRangeLow01) = gDoc.FormFields("adjustedRangeLow01").result dataArray(adjustedRangeHigh01) = gDoc.FormFields("adjustedRangeHigh01").result If (gDoc.FormFields("lithiumYes01").CheckBox.Value = True) Then dataArray(lithiumYes01) = "True" Else dataArray(lithiumYes01) = "False" End If If (gDoc.FormFields("AAYes01").CheckBox.Value = True) Then dataArray(AAYes01) = "True" Else dataArray(AAYes01) = "False" End If If (gDoc.FormFields("USBYes01").CheckBox.Value = True) Then dataArray(USBYes01) = "True" Else dataArray(USBYes01) = "False" End If If (gDoc.FormFields("ACYes01").CheckBox.Value = True) Then dataArray(ACYes01) = "True" Else dataArray(ACYes01) = "False" End If '' TEST SET 2 dataArray(cuvetteLot02) = gDoc.FormFields("cuvetteLot02").result dataArray(cuvetteExpDate02) = gDoc.FormFields("cuvetteExpDate02").result dataArray(controlsLot02) = gDoc.FormFields("controlsLot02").result dataArray(controlsExpDate02) = gDoc.FormFields("controlsExpDate02").result dataArray(labelRangeLow02) = gDoc.FormFields("labelRangeLow02").result dataArray(labelRangeHigh02) = gDoc.FormFields("labelRangeHigh02").result dataArray(adjustedRangeLow02) = gDoc.FormFields("adjustedRangeLow02").result dataArray(adjustedRangeHigh02) = gDoc.FormFields("adjustedRangeHigh02").result If (gDoc.FormFields("lithiumYes02").CheckBox.Value = True) Then dataArray(lithiumYes02) = "True" Else dataArray(lithiumYes02) = "False" End If If (gDoc.FormFields("AAYes02").CheckBox.Value = True) Then dataArray(AAYes02) = "True" Else dataArray(AAYes02) = "False" End If If (gDoc.FormFields("USBYes02").CheckBox.Value = True) Then dataArray(USBYes02) = "True" Else dataArray(USBYes02) = "False" End If If (gDoc.FormFields("ACYes02").CheckBox.Value = True) Then dataArray(ACYes02) = "True" Else dataArray(ACYes02) = "False" End If
'' TEST SET 3 dataArray(cuvetteLot03) = gDoc.FormFields("cuvetteLot03").result dataArray(cuvetteExpDate03) = gDoc.FormFields("cuvetteExpDate03").result dataArray(controlsLot03) = gDoc.FormFields("controlsLot03").result dataArray(controlsExpDate03) = gDoc.FormFields("controlsExpDate03").result dataArray(labelRangeLow03) = gDoc.FormFields("labelRangeLow03").result dataArray(labelRangeHigh03) = gDoc.FormFields("labelRangeHigh03").result dataArray(adjustedRangeLow03) = gDoc.FormFields("adjustedRangeLow03").result dataArray(adjustedRangeHigh03) = gDoc.FormFields("adjustedRangeHigh03").result If (gDoc.FormFields("lithiumYes03").CheckBox.Value = True) Then dataArray(lithiumYes03) = "True" Else dataArray(lithiumYes03) = "False" End If If (gDoc.FormFields("AAYes03").CheckBox.Value = True) Then dataArray(AAYes03) = "True" Else dataArray(AAYes03) = "False" End If If (gDoc.FormFields("USBYes03").CheckBox.Value = True) Then dataArray(USBYes03) = "True" Else dataArray(USBYes03) = "False" End If If (gDoc.FormFields("ACYes03").CheckBox.Value = True) Then dataArray(ACYes03) = "True" Else dataArray(ACYes03) = "False" End If
'Create new form document Set nDoc = Documents.Add(templatePath) 'Populate new form document For arrayIndex = 1 To FF_COUNT 'Application.StatusBar = "Populating form ... " & arrayIndex & " of " & FF_COUNT & "." If dataArray(arrayIndex) = "N/A" Then 'skip Else 'populate form If nDoc.FormFields(arrayIndex).Type = wdFieldFormCheckBox Then 'Checkbox If dataArray(arrayIndex) = "True" Then nDoc.FormFields(arrayIndex).CheckBox.Value = True If dataArray(arrayIndex) = "False" Then nDoc.FormFields(arrayIndex).CheckBox.Value = False Else 'Textbox nDoc.FormFields(arrayIndex).result = dataArray(arrayIndex) End If End If Next MsgBox ("The form is ready for use.")Else'Do nothingEnd IfEnd Sub

Page updated

Google Sites

Report abuse