我需要使用VBA脚本提取具有特定样式的所有文本元素。如果该样式中存在该样式,我可以使其打印该行,但我只需要打印与该样式匹配的文本。
Dim singleLine As Paragraph
Dim lineText As String
For Each singleLine In ActiveDocument.Paragraphs
lineText = singleLine.Range.Text
'Define the style we're searching for
Dim blnFound As Boolean
With singleLine.Range.Find
.style = "Gloss in Text"
Do
'if we find the style "Gloss in Text" in this line
blnFound = .Execute
If blnFound Then
Debug.Print lineText
Exit Do
End If
Loop
End With
Next singleLine
如何仅打印标记为" Gloss in text"的文本的值?风格而不是整条线?
答案 0 :(得分:0)
我想出了如何做到这一点
Sub SearchStyles()
Dim iCount As Integer, iArrayCount As Integer, bFound As Boolean, prevResult As String
'store results in an array
ReDim sArray(iArrayCount) As String
iArrayCount = 1
'State your Style type
sMyStyle = "Gloss in Text"
'Always start at the top of the document
Selection.HomeKey Unit:=wdStory
'Set your search parameters and look for the first instance
With Selection.Find
.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
.Style = sMyStyle
.Execute
End With
'If we find one then we can set off a loop to keep checking
Do While Selection.Find.Found = True And Not Selection.Text = prevResult
iCount = iCount + 1
'If we have a result then add the text to the array
If Selection.Find.Found Then
bFound = True
'print the selection we found
Debug.Print Selection.Text
prevResult = Selection.Text
'We do a check on the array and resize if necessary (more efficient than resizing every loop)
If ii Mod iArrayCount = 0 Then ReDim Preserve sArray(UBound(sArray) + iArrayCount)
sArray(iCount) = Selection.Text
'Reset the find parameters
Selection.Find.Execute
End If
Loop
'Finalise the array to the actual size
ReDim Preserve sArray(iCount)
Dim xli As Integer
For xli = 0 To iCount
Debug.Print sArray(xli)
Next xli
End Sub
如果有更简单/更清洁的方法,我不会感到惊讶,但我已经解决了我的问题。