检测空格是否在书签旁边,如果没有添加它们

时间:2012-12-04 13:30:34

标签: vba ms-word word-vba word-2003

我在几个Word文档中有几个书签,需要在所有书签之前和之后添加空格,其中一侧或两侧当前不存在单个空格。我只希望能够解析当前文件。

我尝试了几种方法,其中一些方法可以创建无限循环。

使用以下代码,我取得了一定程度的成功,但它在此过程中创建了一个infinate循环。我已经尝试查看Bookmark对象,依次选择每个对象并在前后添加一个空格,这会导致空格放在书签中,或者忽略空间应该放在哪里并将其放在后面。

我有一个宏,我在文档上运行,显示书签并将其放在多于和少于这个“««bookmarkname»»”之类的符号之间,以便于解析。

这是我的代码:

Sub new_test()
    Dim sT As String
    Dim boo As Boolean
    boo = False

    Selection.Find.ClearFormatting
    With Selection.Find
         .Text = "««*»»[ ]"
        .Forward = False
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
         Do While .Execute
            With Selection
                'sT = Selection.Text

                If (boo = False) Then
                    MsgBox "Added a character after bookmark"
                    Selection.InsertAfter (" ")
                    boo = True
                End If
            End With
            boo = False
        Loop
    End With
End Sub

1 个答案:

答案 0 :(得分:0)

好的 - 解决了。也许它会证明对某人有用。

在我运行之前,我在文档上运行了另一个函数,它显示了所有书签,并且放置了比这些更多和更少的符号:"««BOOKMARKNAME»»"

Sub bookmarks_ensure_space_beforeAfter()

    ' Before we can do any work, we need a list of bookmarks from the document
    Dim bmks As Variant
    bmks = create_array_of_bookmark_names() ' array of bookmark names

    ' This Assumes that there will not be more than 1000 bmks in the array fetched from the Word Doc

    For i = 0 To 1000

        If (bmks(i) <> "") Then
            ' if the 'bmk' is not null then process it
            ' there are likely to be several 100 that are empty

            Dim wrd As String
            Dim rng As Range

            Call select_a_string("««" & bmks(i) & "»»") ' select the bookmark
            wrd = "««" & bmks(i) & "»»"
            Set rng = Selection.Range

            ' now move the cursor two places the left of the bookmark
            Selection.MoveLeft Unit:=wdCharacter, count:=2
            ' now select the character infront of the cursor (which is now the character infront of the bmk)
            Selection.MoveRight Unit:=wdCharacter, count:=1, Extend:=wdExtend
            If (Selection.Text <> " ") Then
                ' if this character now selected is not a space - add one
                rng.InsertBefore " "
            End If

            ' now move the cursor to the right of the bookmark (using it's length as a character limit)
            Selection.MoveRight Unit:=wdCharacter, count:=Len(wrd) + 1
            ' due to bookmarks being fiddly, recreate the same bmk directly after the original
            With ActiveDocument.Bookmarks
                .Add Range:=Selection.Range, Name:=bmks(i)
                .DefaultSorting = wdSortByName
                .ShowHidden = False
            End With

            ' now we have a new bmk, select the character directly after the bmk)
            Selection.MoveRight Unit:=wdCharacter, count:=1, Extend:=wdExtend

            If (Selection.Text <> " ") Then
                ' if this character now selected is not a space - add one
                rng.InsertAfter " "
            End If

        End If
    Next
End Sub

Function create_array_of_bookmark_names() As Variant
    ' This function creates an array of bookmarks in the document and returns them as an array
    Dim array_of_bmk(1000) As Variant
    Dim c As Integer
    c = 0
    For Each mBookmark In ActiveDocument.Bookmarks()
        array_of_bmk(c) = mBookmark.Name
        c = c + 1
    Next
    ' now return this array
    create_array_of_bookmark_names = array_of_bmk

End Function
Sub select_a_string(str)
    ' This finds and selects a string of characters
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = str
        '.Replacement.Text = ""
        .Forward = True
        .MatchCase = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
End Sub