在此先感谢您抽出宝贵的时间阅读此书。
我想在Word 2013中编写“查找”功能,以搜索多种样式的特定单词。甚至不确定这是否可行,因为Word在高级查找->更多->格式->样式中没有该选项。它仅允许过滤一种样式。
我的目标是能够在样式“标题1”到“标题9”中找到段落标记(语法:^ p)。
Sub AppendixFix()
' Declaring variables
Dim multiStyles As String, i As Integer
multiStyles = "Heading 1, Heading 2, Heading 3, Heading 4, Heading 5, Heading 6, Heading 7, Heading 8, Heading 9"
' Start at the top of document and clear find formatting
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
' Navigate to Appendix section
Selection.Find.Style = ActiveDocument.Styles("Heading 1")
With Selection.Find
.Text = "Appendix"
.Forward = True
.Wrap = wdFindAsk
.Format = True
.Execute
End With
' Loop until find is not found and limit to 1000 counts
Do While Selection.Find.Found = True And i < 1000
i = i + 1
' Add text to the beginning of each line
Selection.HomeKey Unit:=wdLine
Selection.TypeText Text:=" *Test* "
' Navigate to the next heading by looking at following paragraph mark
Selection.Find.Style = ActiveDocument.Styles(multiStyles)
With Selection.Find
.Text = "^p"
.Forward = True
.Wrap = wdFindStop
.Format = True
.Execute
.Execute
End With
Loop
End Sub
我希望代码在第一个“附录”标题处开始输入 Test ,然后在其子标题(标题2、3 ..., 9),并继续到文档末尾。但是,它仅将文本添加到“标题1”样式的标题中,从而跳过了其子标题。在我看来,只有列表中的第一种样式可以读取。我尝试从列表中删除标题1,并检查标题2样式的标题。
答案 0 :(得分:1)
以下内容基于我对问题中文档设置的理解,在测试文档中为我工作。
代码需要循环样式。为此,样式必须位于可以循环的内容中- 数组 。 Split
方法基于 定界符 将列表分成数组。分隔符只能是一个字符,因此需要从问题代码中的multiStyles
中删除逗号后的空格。
循环时,重要的是要返回每种样式的起点(附录)。为此,下面的代码使用了Range
对象。
仅在发现问题后才添加“测试”文本。下面的代码使用布尔变量存储Find.Execute
返回的值(如果找到,则返回true),以便可以可靠地测试此值以及Loop Until
。
查找可能会结束于文档末尾。在这种情况下,代码会陷入无尽的循环,因此需要测试将结束位置移至列表中的下一个样式。
Sub AppendixFix()
' Declaring variables
Dim multiStyles As String, i As Integer
Dim aStyleList As Variant
Dim counter As Long, s As String, found As Boolean
Dim rngStart As Range
multiStyles = "Heading 1,Heading 2,Heading 3,Heading 4,Heading 5,Heading 6,Heading 7,Heading 8,Heading 9"
aStyleList = Split(multiStyles, ",")
' Start at the top of document and clear find formatting
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
' Navigate to Appendix section
Selection.Find.style = ActiveDocument.styles("Heading 1")
With Selection.Find
.Text = "Appendix"
.Forward = True
.wrap = wdFindStop
.Format = True
.Execute
End With
Selection.HomeKey Unit:=wdLine
Selection.TypeText Text:=" *Test* "
Selection.MoveStart wdParagraph, 1
Set rngStart = Selection.Range.Duplicate
' Loop through all the styles in the list
For counter = LBound(aStyleList) To UBound(aStyleList)
'Loop as long as the style is found
Do
s = aStyleList(counter)
With Selection.Find
.style = ActiveDocument.styles(s)
.Text = "^p"
.Forward = True
.wrap = wdFindStop
.Format = True
found = .Execute
End With
' Add text to the beginning of each line
If found Then
Selection.HomeKey Unit:=wdLine
Selection.TypeText Text:=" *Test* "
Selection.MoveStart wdParagraph, 1
End If
If Selection.Start = ActiveDocument.content.End - 1 Then
'End of Document, then loop to next style in list
Exit For
End If
Loop Until found = False
'start back at the Appendix for the next style
rngStart.Select
Next
End Sub
答案 1 :(得分:0)
试一下-我相信这会将测试添加到每个标题的末尾。很难说出您想从问题中做什么。
Sub AppendixFix()
' Declaring variables
Dim multiStyles As Variant, i As Integer
multiStyles = Array("Heading 1", "Heading 2", "Heading 3", "Heading 4", "Heading 5", "Heading 6", "Heading 7", "Heading 8", "Heading 9")
' Start at the top of document and clear find formatting
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
' Navigate to Appendix section
Selection.Find.Style = ActiveDocument.Styles("Heading 1")
With Selection.Find
.Text = "Appendix"
.Forward = True
.Wrap = wdFindAsk
.Format = True
.Execute
End With
' Loop until find is not found and limit to 1000 counts
Do While Selection.Find.Found = True And i < 1000
i = i + 1
' Add text to the beginning of each line
Selection.HomeKey Unit:=wdLine
Selection.TypeText Text:=" *Test* "
' Navigate to the next heading by looking at following paragraph mark
For j = 0 To UBound(multiStyles)
Selection.Find.Style = ActiveDocument.Styles(multiStyles(j))
With Selection.Find
.Text = "^p"
.Forward = True
.Wrap = wdFindStop
.Format = True
.Execute
.Execute
End With
Selection.TypeText Text:=" *Test* "
Next j
Loop
End Sub