使用给定样式VBA提取元素的文本

时间:2016-11-14 16:03:55

标签: vba word-vba word-style

我需要使用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"的文本的值?风格而不是整条线?

1 个答案:

答案 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

如果有更简单/更清洁的方法,我不会感到惊讶,但我已经解决了我的问题。