[英]Extract text of elements with given style VBA
I need to extract all text elements with a certain style using a VBA script. 我需要使用VBA脚本提取具有特定样式的所有文本元素。 I can make it print the line if that style exists within the line, but I need to print only the text matching that style.
如果该样式存在于行中,则可以使它打印该行,但是我只需要打印与该样式匹配的文本即可。
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
How can I print only the value of the text tagged with the "Gloss in text" style rather than the entire line? 如何只打印标记有“文本光泽”样式的文本的值,而不打印整个行?
I figured out how to do this 我想出了怎么做
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
I wouldn't be surprised if there's a simpler/cleaner way to do this, but I've solved my problem. 如果有更简单/更干净的方法来执行此操作,我不会感到惊讶,但是我已经解决了我的问题。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.