Hi all,
New to working with VBA in both Word and Excel and been relying on the wonderful support of the internet community to help me along. I'm building some documents for work, H&S stuff, that would automatically include some autotext entries based on checkboxes selected, then save as a PDF. It would be a template that we wouldn't allow to be saved over.
What I would like is for someone to view the code I've cobbled together, and let me know where I can make both corrections to any silly design choices, and efficiency.
Two issues I am dealing with is flickering during the checkbox loop (I think it's there), and odd crashes every so often when the code has run successfully.
I realise this is probably quite a big ask so I'm certainly not expecting vast responses, but the odd efficiency suggestion would be most appreciated.
In the code, anything starting with Tx is a text field, and Ck a checkbox.
Code below:
Sub CommandBuildDoc()
If ActiveDocument.FormFields("TxMAIN_EVENT").Result = "" Or ActiveDocument.FormFields("TxMAIN_EVENTMGR").Result = "" Then
MsgBox "Event name and Event Manager must be entered before building the document."
Else
If MsgBox("Are all selections correct? This action cannot be undone and you may need to start the process again.", vbYesNo, "Warning") = vbYes Then
Application.ScreenUpdating = False
If ActiveDocument.ProtectionType <> wdNoProtection Then
Application.ActiveDocument.Unprotect "password"
End If
Dim docFields As FormFields
Dim oneField As FormField
Dim thisFieldName As String
Set docFields = ActiveDocument.FormFields
For Each oneField In docFields
If oneField.Type = wdFieldFormCheckBox Then
If Left(oneField.Name, 6) = "CkKIT_" Then
If oneField.Result = True Then
thisFieldName = Replace(oneField.Name, "CkKIT_", "autoRA")
AutoTextToBM "TaskRiskAssessments", ActiveDocument.AttachedTemplate, thisFieldName
End If 'End Result is true check
'ElseIf Left(oneField.Name, 6) = "CkPPE_" Then ---THIS BIT READY FOR WHEN WE WANT IT---
'thisFieldName = Replace(oneField.Name, "Ck", "")
End If 'End checkbox name check
ElseIf oneField.Type = wdFieldFormTextInput Then
If Left(oneField.Name, 6) = "TxKIT_" And Len(oneField.Result) > 0 Then
If ActiveDocument.Bookmarks.Exists("AdditionalEquipTitle") = True Then 'Puts a title in place
ActiveDocument.Bookmarks("AdditionalEquipTitle").Range.InsertAfter "Risk assessments for the following additional equipment must be appended:" & vbNewLine
ActiveDocument.Bookmarks("AdditionalEquipTitle").Delete
End If
thisFieldName = oneField.Result
Dim oRng As Range
Set oRng = ActiveDocument.Bookmarks("AdditionalEquip").Range
i = 1
oRng.InsertAfter i & " " & thisFieldName & vbNewLine
i = i + 1
ActiveDocument.Bookmarks.Add Name:="AdditionalEquip", Range:=oRng
End If 'End textfield subject and length check
End If 'End field type check
Next
Set docFields = Nothing
Call SaveAsPDF
End If 'End Event name and manager entered check
Application.ActiveDocument.Protect wdAllowOnlyFormFields, Password:="password", noreset:=True
End If 'Ends message box confirmation IF
Application.ScreenUpdating = True
End Sub
Sub AutoTextToBM(strbmName As String, oTemplate As Template, strAutotext As String)
'strBMName is the bookmark - should be TaskRiskAssessments
'oTemplate is ActiveDocument.AttachedTemplate
'strAutotext is the name of the autotext entry - always starts with autoRA
Dim oRng As Range
On Error GoTo lbl_Exit
With ActiveDocument
Set oRng = .Bookmarks(strbmName).Range
oRng.Collapse Direction:=wdCollapseEnd
Set oRng = oTemplate.AutoTextEntries(strAutotext).Insert(Where:=oRng, RichText:=True)
.Bookmarks.Add Name:=strbmName, Range:=oRng
End With
lbl_Exit:
Exit Sub
End Sub
Sub SaveAsPDF()
Dim strCurrentFolder As String
Dim strFileName As String
Dim strMyPath As String
Dim strFullName As String
ActiveDocument.CommandButton1.Select 'Remove command button
'Selection.Delete
'Store Information About Word File
strMyPath = ActiveDocument.FullName
strCurrentFolder = ActiveDocument.AttachedTemplate.Path & "\"
strFileName = "Method Statement-" & _
Replace(ActiveDocument.FormFields("TxMAIN_EVENT").Result, " ", "_") & "_" & _
Replace(ActiveDocument.FormFields("TxMAIN_EVENTMGR").Result, " ", "_") & _
"-" & Replace(Date, "/", "-") & ".pdf"
ActiveDocument.ExportAsFixedFormat OutputFilename:=strCurrentFolder & strFileName, _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateHeadingBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False
MsgBox "File: " & UCase(strFileName) & " saved in " & strCurrentFolder
End Sub