Extrahieren von Text von Elementen mit gegebenem Stil VBA

Question

Ich muss alle Textelemente mit einem bestimmten Stil mithilfe eines VBA-Skripts extrahieren. Ich kann es machen, die Linie zu drucken, wenn dieser Stil innerhalb der Linie existiert, aber ich muss nur den Text drucken, der diesem Stil entspricht.

Wie kann ich nur den Wert des Textes drucken, der mit dem Text "Gloss in text" getaggt ist und nicht die gesamte Zeile?

Answer 1

habe ich herausgefunden, wie man diesen

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 

zu tun, würde ich nicht überrascht, wenn es ein einfacherer/sauberer Weg, dies zu tun, aber ich habe mein Problem gelöst.