Replace range text then insert a symbol

Question

I am attempting to insert text into the footer, I am running into problems with inserting a symbol after my inserted text so that I can easily replace that text on future calls of the code.

In the following code Word will crash after calling the sub, I suspect it is failing at the oRng.Collapse wdCollapseEnd and oRng.InsertSymbol lines, perhaps it is failing to exit the loop?

Public Sub UpdateFooter()

    Dim objRange As Range
    Dim strCurrentView As String
    Dim objSection As Section
    Dim objHeaderFooter As HeaderFooter
    Dim rng As Word.Range

    ' Turn off screen updating
    Application.ScreenUpdating = False

    ' Loop through sections
    For Each objSection In ActiveDocument.Sections

        Set rng = objSection.Footers(Word.WdHeaderFooterIndex.wdHeaderFooterFirstPage).Range

        Dim oRng As Word.Range

        Set oRng = rng

        oRng.Collapse wdCollapseStart

        ' Find existing U+61472 symbol, which means footer text has already been inserted
        With oRng.Find
            .ClearFormatting
            .Text = ChrW(61472)
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            Do While (.Execute = True) = True
                If .Found = True Then
                    ' Found, select first word through to and including the symbol
                    oRng.MoveStart wdWord, -1
                    oRng.MoveEnd wdCharacter, 1
                Else
                    ' Not found
                    oRng.MoveEnd wdStory, 1
                End If

                ' Insert new text
                oRng.Font.Name = "Arial"
                oRng.Font.Size = 8
                oRng.Text = "TEST_TEXT"

                ' Insert symbol after the new text so that we can replace in future
                'oRng.Collapse wdCollapseEnd
                'oRng.InsertSymbol Font:="Wingdings", CharacterNumber:=-4064, Unicode:=True
            Loop
        End With
    Next

    ' Set view back to Print View and enabled screen updating
    ActiveDocument.PrintPreview
    ActiveDocument.ClosePrintPreview
    Application.ScreenUpdating = True

End Sub

This code will perform a find for the symbol U+61472, if found the text from the start of the line to the symbol will be selected and the text replaced, if the symbol isn't found then the text will be inserted.

If I remove the

oRng.Collapse wdCollapseEnd
oRng.InsertSymbol Font:="Wingdings", CharacterNumber:=-4064, Unicode:=True

The footer text is inserted but without the symbol any future saves will have the text re-inserted as duplicates instead of being replaced.

How would I go about inserting text in the selected range, and then adding a symbol after the inserted text?

Could you please provide a full minimal reproducible example. That means a complete Sub from beginning to end that displays the behavior. This will include, of course, information about the saving part: How is the save being initialized? And how is the code being triggered at that point? Without that information it's not possible to trouble-shoot the issue. — Cindy Meister
I have updated the question to include a functional sub which demonstrates the behaviour I am experiencing. If you remove the two lines identified the sub will succeed. — Lima
It doesn't crash for me, but I did change the InsertSymbol line to oRng.Text = ChrW(61472) since that's simpler? But you might find it easier/faster to work with Bookmarks instead of using this approach. — Cindy Meister
I think Word lets you use a bookmark for this. You have a document that has an existing bookmark, or you create one with VBA. Then, you can overwrite bookmarks. docs.microsoft.com/en-us/office/vba/api/word.bookmarks — jessi

Lima Lima · Accepted Answer · 2019-07-05T14:08:59

I ended up resolving this by doing the insert symbol outside the while loop.

Public Sub UpdateFooter()
Dim objRange As Range
Dim strCurrentView As String
Dim objSection As Section
Dim objHeaderFooter As HeaderFooter
Dim rng As Word.Range

' Turn off screen updating
Application.ScreenUpdating = False

' Loop through sections
For Each objSection In ActiveDocument.Sections

    Set rng = objSection.Footers(Word.WdHeaderFooterIndex.wdHeaderFooterFirstPage).Range

    Dim oRng As Word.Range

    Set oRng = rng

    oRng.Collapse wdCollapseStart

    ' Find existing U+61472 symbol, which means footer text has already been inserted
    With oRng.Find
        .ClearFormatting
        .Text = ChrW(61472)
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        Do While (.Execute = True) = True
            If .Found = True Then
                ' Found, select first word through to and including the symbol
                oRng.MoveStart wdWord, -1
                oRng.MoveEnd wdCharacter, 1
            Else
                ' Not found
                oRng.MoveEnd wdStory, 1
            End If

            ' Insert new text
            oRng.Font.Name = "Arial"
            oRng.Font.Size = 8
            oRng.Text = "TEST_TEXT"


        Loop
    End With
 Insert symbol after the new text so that we can replace in future
 oRng.Collapse wdCollapseEnd
 oRng.InsertSymbol Font:="Wingdings", CharacterNumber:=-4064, Unicode:=True

Next

' Set view back to Print View and enabled screen updating
ActiveDocument.PrintPreview
ActiveDocument.ClosePrintPreview
Application.ScreenUpdating = True

End Sub

Replace range text then insert a symbol

1 Answers