Consulting

Results 1 to 5 of 5

Thread: Word VBA efficiency (novice)

  1. #1

    Question Word VBA efficiency (novice)

    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
    Last edited by Aussiebear; 04-30-2025 at 01:09 AM.

  2. #2
    I would suggest that content controls make more sense than form fields. You don't have to worry about document protection (though you can use it) and you can call the controls by title or tag. The following can be used to insert an autotext entry into a rich text content control.

    Sub AutoTextToCC(strCCName As String, oTemplate As Template, strAutotext As String)
        ' Graham Mayor - https://www.gmayor.com - Last updated - 10 Apr 2019
        ' strCCName is the ContentControl title
        ' oTemplate is the template with the autotext entry
        ' strAutotext is the name of the autotext entry
        Dim oCC As ContentControl
        On Error GoTo lbl_Exit
        For Each oCC In ActiveDocument.ContentControls
            If oCC.TITLE = strCCName Then
                oCC.LockContentControl = True
                oTemplate.AutoTextEntries(strAutotext).Insert Where:=oCC.Range, RichText:=True
                Exit For
            End If
        Next oCC
        lbl_Exit:
        Exit Sub
    End Sub
    You may find http://www.gmayor.com/insert_content_control_addin.htm useful when converting your document.
    Last edited by Aussiebear; 04-30-2025 at 01:10 AM.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3

    Thanks

    Quote Originally Posted by gmayor View Post
    I would suggest that content controls make more sense than form fields. You don't have to worry about document protection (though you can use it) and you can call the controls by title or tag. The following can be used to insert an autotext entry into a rich text content control.
    Many thanks Graham,
    I'll certainly look into that, it's a good point, although one or two fields currently need a length limit and I'm happy with using document protection so users are very limited.

    Can several autotext entries go into a single content control one after the other, or do they need their own field?
    A

  4. #4
    You can insert more than one autotext entry into a content control, one after another, but you would need to modify the code to allow that e.g. the following will insert the

    Sub AutoTextToCC2(strCCName As String, oTemplate As Template, strAutotext As String)
        ' Graham Mayor - https://www.gmayor.com - Last updated - 10 Apr 2019
        ' strCCName is the ContentControl title
        ' oTemplate is the template with the autotext entry
        ' strAutotext is the name of the autotext entry
        Dim oCC As ContentControl
        Dim oRng As Range
        On Error GoTo lbl_Exit
        For Each oCC In ActiveDocument.ContentControls
            If oCC.TITLE = strCCName Then
                oCC.LockContentControl = True
                Set oRng = oCC.Range
                If oCC.ShowingPlaceholderText = False Then
                    oRng.Collapse 0
                End If
                oTemplate.AutoTextEntries(strAutotext).Insert Where:=oRng, RichText:=True
                Exit For
            End If
        Next oCC
        lbl_Exit:
        Exit Sub
    End Sub
    You can use macros to limit the length of the content of a control.
    Last edited by Aussiebear; 04-30-2025 at 01:10 AM.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5

    Thumbs up Thanks again

    Quote Originally Posted by gmayor View Post
    You can insert more than one autotext entry into a content control, one after another, but you would need to modify the code to allow that e.g. the following will insert the

    ...

    You can use macros to limit the length of the content of a control.
    Thanks very much for you help Graham.

    Cheers
    A

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •