Question

嗯，如果你只是想帮我解决这个问题对我来说非常有帮助，这对我的实习非常重要，这对我来说非常重要。我使用这个工具来排序一些'产品属性'。我需要搜索“文章”的类型，然后当找到特定的“文章”时，我会添加一个脚注。 我在下面这样做了

Sub Find()'There is many other Calls but lets take those for example
   Call SearchAndMark("Article : KR", "arKR")
   Call SearchAndMark("Article : IP", "arIP")
   Call SearchAndMark("Article : IA", "arIA")
   Call SearchAndMark("Article : 12", "ar12000") 
End Sub

这是我的功能SearchAndMark

Sub SearchAndMark(searchString As String, markText As String)
Dim CurrentPage As Integer
Dim LastPage As Integer

Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
CurrentPage = Selection.Information(wdActiveEndAdjustedPageNumber)
LastPage = Selection.Information(wdNumberOfPagesInDocument)

While (CurrentPage < LastPage)
    Selection.Find.Forward = True
    Selection.Find.Text = searchString
    Selection.Find.Execute

    If Selection.Find.Found Then
        CurrentPage = Selection.Information(wdActiveEndAdjustedPageNumber)
        Debug.Print "Found on Page " & CurrentPage
        Call ActiveDocument.Footnotes.Add(Selection.range, "", markText)
    Else
    CurrentPage = LastPage
    End If
Wend
End Sub

现在，我的问题，我需要什么？ 好吧，其他页面包含未经研究的文章的描述，名称未知，我还需要在所有页面的末尾添加另一个相同的脚注或标签。 另一个想法： 我试图在所有页面的末尾写一个相同的标签，然后在研究我的'searchString'时，我标记一个新的并删除旧的。 但我没有得到结果，执行错误！也许是因为函数'Selection.Find'会失去方法。

如果您有问题，请告诉我。感谢您的帮助

Answer 1

一种方法是使用字典来跟踪每个页面是否添加了脚注。在代码的最后，您可以通读字典来查找尚未标记的页面，然后对它们执行某些操作。

要使用Scripting.Dictionary对象的早期绑定，请从VBA IDE中选择“工具”菜单，然后选择“引用”。找到＆＃34; Microsoft Scripting Runtime＆＃34;的条目。并选中复选框。

在代码的开头，调用一个函数来创建字典，其中每个页面都有一个条目，值False表示没有添加脚注。在以后的代码中，添加脚注时，还会更改该页面的字典中的值。

这是代码。

Option Explicit

Sub Find() 'There is many other Calls but lets take those for example

Dim dictOfPages As Scripting.Dictionary

    Set dictOfPages = BuildDict()

   Call SearchAndMark("Article : KR", "arKR", dictOfPages)
   Call SearchAndMark("Article : IP", "arIP", dictOfPages)
   Call SearchAndMark("Article : IA", "arIA", dictOfPages)
   Call SearchAndMark("Article : 12", "ar12000", dictOfPages)

   Call MarkRemainingPages(dictOfPages)

End Sub

Sub SearchAndMark(searchString As String, markText As String, ByRef dictOfPages As Scripting.Dictionary)
Dim CurrentPage As Integer
Dim LastPage As Integer

Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
CurrentPage = Selection.Information(wdActiveEndAdjustedPageNumber)
LastPage = Selection.Information(wdNumberOfPagesInDocument)

While (CurrentPage < LastPage)
    Selection.Find.Forward = True
    Selection.Find.Text = searchString
    Selection.Find.Execute

    If Selection.Find.Found Then
        CurrentPage = Selection.Information(wdActiveEndAdjustedPageNumber)
        Debug.Print "Found on Page " & CurrentPage
        dictOfPages.item(CurrentPage) = True
        Call ActiveDocument.Footnotes.Add(Selection.Range, "", markText)
    Else
    CurrentPage = LastPage
    End If
Wend
End Sub

Private Function BuildDict() As Scripting.Dictionary

Dim theDict As Scripting.Dictionary
Dim i As Integer

    Set theDict = New Scripting.Dictionary

    For i = 1 To Selection.Information(wdNumberOfPagesInDocument)
        theDict.Add i, False
    Next i

    Set BuildDict = theDict

End Function

Private Sub MarkRemainingPages(ByRef dictOfPages As Scripting.Dictionary)

Dim pageNum As Variant

    For Each pageNum In dictOfPages.Keys
        If Not dictOfPages.Item(CInt(pageNum)) Then
            Debug.Print "Not found on page " & pageNum
            ' Do something here, add another footnote or text in the footer
        End If
    Next pageNum
End Sub

Answer 2

大家好，这是我的最终解决方案，我只是强调了所有我正在搜索的文章。然后，很容易找到所有其他非下划线。 请看下面的内容。

Sub Find()
Call SearchAndMark("Article : KR", "arKR") 
Call SearchAndMark("Article : IP", "arIP")
Call SearchAndMark("Article : IA", "arIA")
Call SearchAndMark("Article : 12", "ar12000")
End Sub


Sub SearchAndMark(searchString As String, markText As String)
Dim CurrentPage As Integer
Dim LastPage As Integer

Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
CurrentPage = Selection.Information(wdActiveEndAdjustedPageNumber)
LastPage = Selection.Information(wdNumberOfPagesInDocument)

While (CurrentPage < LastPage)
    Selection.Find.Forward = True
    Selection.Find.Text = searchString
    Selection.Find.Execute

    If Selection.Find.Found Then
'Here i underline these names
        Selection.Font.Underline = wdUnderlineSingle
        CurrentPage = Selection.Information(wdActiveEndAdjustedPageNumber)
        Debug.Print "Found on Page " & CurrentPage
        Call ActiveDocument.Footnotes.Add(Selection.range, "", markText)
    Else
    CurrentPage = LastPage
    End If
Wend
End Sub

在此之后，我添加了一个新功能来搜索＆＃34;文章：^？＆＃34;没有加下划线的

Sub underlineTXT()
Dim CurrentPage As Integer
Dim LastPage As Integer

Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
CurrentPage = Selection.Information(wdActiveEndAdjustedPageNumber)
LastPage = Selection.Information(wdNumberOfPagesInDocument)

While (CurrentPage < LastPage)
    Selection.Find.Forward = True
    Selection.Find.Text = "Article : ^?"
    Selection.Find.Execute

    If Selection.Font.Underline = wdUnderlineNone Then
    CurrentPage =Selection.Information(wdActiveEndAdjustedPageNumber)
    Call ActiveDocument.Footnotes.Add(Selection.range, "", "Défauts")
    Else
          Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
    End If
 Wend
 End Sub

这就是全部，感谢所有人的宝贵贡献

Word VBA：搜索字符串然后执行以防万一

2 个答案: