Vba 解析Word文档以插入交叉引用

Vba 解析Word文档以插入交叉引用,vba,ms-word,Vba,Ms Word,我有一个word文档中的特定文本,该文档已添加书签。我想使用Word VBA对相同的单词解析文档,并插入交叉引用。由于某种原因,当我插入交叉引用时,代码不会移动到下一个单词 Sub ReplaceTextwithCrossRef() Dim BMtext As String Dim BMname As String Dim Sel As Selection Set Sel = Application.Selection BMname = Sel.Bookmarks(1).Name BMtex

我有一个word文档中的特定文本,该文档已添加书签。我想使用Word VBA对相同的单词解析文档,并插入交叉引用。由于某种原因,当我插入交叉引用时,代码不会移动到下一个单词

Sub ReplaceTextwithCrossRef()

Dim BMtext As String
Dim BMname As String
Dim Sel As Selection
Set Sel = Application.Selection

BMname = Sel.Bookmarks(1).Name
BMtext = Sel.Text
MsgBox BMname
MsgBox BMtext

For Each oWd In ActiveDocument.Words

oWd.Select

If oWd.Text = BMtext Then

If Selection.Bookmarks.Exists(BMname) Then

Else

Selection.InsertCrossReference ReferenceType:=wdRefTypeBookmark, _
        ReferenceKind:=wdContentText, ReferenceItem:=BMname

Selection.MoveDown Unit:=wdLine, Count:=1

End If

Else

End If

Next oWd

End Sub
用户选择一个书签单词,代码移动到该单词的下一个实例,并交叉引用它。i、 e

书签编辑

单词1

单词2

书签编辑

单词3


它将在BOOKMARKEDITEM的第二个实例上插入交叉引用,但不会移动到WORDS3。它会被卡住并继续返回交叉引用,即使我告诉它向下移动下一行代码。任何帮助都将不胜感激。

我解决了自己的问题。使用“Do”、“With”和“If Else”语句,而不是循环遍历每个单词。我认为由于某种原因,交叉引用插入将“For”循环拧紧。以下是解决方案:

Sub ReplaceTextwithCrossRef()

    Dim BMtext As String
    Dim BMname As String
    Dim Counter As Long
    Dim Counter2 As Long

    Dim Sel As Selection
    Set Sel = Application.Selection

    'Select the bookmark
    BMname = Sel.Bookmarks(1).Name
    BMtext = Sel.Text
    MsgBox "This is the bookmark: " & BMname
   ' MsgBox BMtext

    'Select all of the document and search
    ActiveDocument.Range.Select
    Do
        With Selection.Find
            .ClearFormatting
            .Text = BMtext
            .Replacement.Text = ""
            .Format = False
            .MatchWildcards = False
            .Wrap = wdFindStop
            .Execute
        End With

        If Selection.Find.Found Then
        'Overall counter
            Counter = Counter + 1
                'Check if the select is bookmarked
                If Selection.Bookmarks.Exists(BMname) Then
                    'Do nothing and move on
                Else
                    'Insert the cross referebce
                    Selection.InsertCrossReference ReferenceType:=wdRefTypeBookmark, _
                    ReferenceKind:=wdContentText, ReferenceItem:=BMname
                    Counter2 = Counter2 + 1
                End If
        End If
    Loop Until Not Selection.Find.Found

    'Tell how many we found
    MsgBox "We found " & Counter & " instances of " & BMtext & " and " & Counter2 & " cross references were made."

End Sub
编辑:添加代码以添加字符格式

如果要在插入交叉引用之前保留原始格式,请在“Counter2”和End If语句之间使用以下代码编辑字段代码。我在网上搜索了很长时间,找到了一些有用的东西,这就是我想到的:

    Dim oField As Field
    Dim sCode As String
    'Move left and select the reference
                    Selection.MoveLeft Unit:=wdWord, Count:=1
                    Selection.Expand Unit:=wdWord
    'Check reference and add Charformat
                    For Each oField In Selection.Fields
                        If oField.Type = wdFieldRef Then
                            sCode = oField.Code.Text
                            If InStr(sCode, "Charformat") = 0 Then oField.Code.Text = sCode & "\*Charformat"
                        End If
                    Next
    'Move the cursor past the cross reference
                    Selection.Fields.Update
                    Selection.MoveRight Unit:=wdWord, Count:=1