Word VBA efficiency (novice)

[A_Lexbury]

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