替换范围文本,然后插入符号

时间:2019-07-04 12:42:37

标签: vba ms-word word-vba

我试图在页脚中插入文本,我在插入的文本后插入符号时遇到问题,以便在以后的代码调用中轻松替换该文本。

在下面的代码中,Word在调用子程序后将崩溃,我怀疑它在oRng.Collapse wdCollapseEndoRng.InsertSymbol行中失败了,也许它未能退出循环?

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

此代码将对符号U + 61472进行查找,如果找到该行,则从该行的开头到该符号的文本将被选择并替换该文本,如果未找到该符号,则将插入该文本

如果我删除

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

插入了页脚文本,但是如果没有任何符号,则以后保存时,文本将重新插入为重复项,而不是被替换。

如何在选定范围内插入文本,然后在插入的文本后添加符号?

1 个答案:

答案 0 :(得分:0)

我最终通过在while循环外执行插入符号来解决了这个问题。

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