MS Word-Makro zum Korrigieren von teilweise formatierten Wörtern

Question

Ich habe ein Makro erstellt, das alle Zeichen in einem Text ersetzt, von alten Transkriptionsschriftarten zu einer Unicode-Schriftart. Ich weiß nicht warum, aber einige Charaktere behalten die ursprüngliche Formatierung, während andere die Formatierung verlieren (in meinem Fall meistens kursiv), oft innerhalb desselben Wortes. Dies hinterlässt viele Wörter, in denen einige Buchstaben kursiv geschrieben sind, und andere Buchstaben sind nicht kursiv (z. B. "al-Malik al-Mu verdeckt ba"). Die Zeichen, die die Formatierung verlieren, sind alle Zeichen mit diakritischen Zeichen, aber nicht alle Zeichen mit diakritischen Zeichen verlieren ihre Formatierung (z. B. das ḫ in dem Beispiel).

Was wäre der beste Weg, um alle Wörter zu finden, die mindestens einen Buchstaben in Kursivschrift haben, und alle diese Wörter kursiv formatieren?

Wenn mir jemand auf eine Lösung für das ursprüngliche Problem hinweisen könnte, wäre das natürlich noch besser (aber das ist das Thema einer anderen Frage: some characters lose formatting in vba macro others don't).

Answer 1

Der Code unten beantwortet die Frage, ‚alle Wörter finden, die in Kursivschrift mindestens einen Buchstaben haben und kursiv anwenden Formatierung an alle, die Worte‘

Ich habe Kommentare hinzugefügt zu beschreiben, was geschieht. Ich habe Word sehr oft automatisiert und finde, dass es viele Eigenheiten hat, also funktionierte das unten in einem einfachen Test, aber Sie sollten gründlich testen, bevor Sie Code in die Wildnis freigeben.

Public Sub Sample() 
Dim WdDoc As Word.Document 
Dim WdSlct As Word.Selection 
Dim WdFnd As Word.Find 
Set WdDoc = ThisDocument 
    WdDoc.Content.Select 
    Set WdSlct = Selection 
     WdSlct.SetRange 0, 0 
     Set WdFnd = WdSlct.Find 

      'Clear any previous find settings 
      WdFnd.ClearAllFuzzyOptions 
      WdFnd.ClearFormatting 
      WdFnd.ClearHitHighlight 

      'Set the find to look for italic text 
      WdFnd.Font.Italic = True 

      'Look for any italic character 
      Do Until Not WdFnd.Execute(FindText:="?", MatchWildcards:=True, Forward:=True, Wrap:=wdFindStop, Format:=True, Replace:=wdReplaceNone) 

       'Expand the selection to the whole word 
       WdSlct.Expand wdWord 

       'Set the word to be italic 
       WdSlct.Font.Italic = True 

       'Move past the word 
       WdSlct.SetRange WdSlct.End, WdSlct.End 
      Loop 
     Set WdFnd = Nothing 
    Set WdSlct = Nothing 
Set WdDoc = Nothing 
End Sub 

---

Angepasst von Bearbeitungsanforderung von @peterv (die OP)

Um diese Arbeit in den Fußnoten, Überschriften und andere Storyrange zu machen, angepasst I-Lösung Gary indem sie sie mit this trick Kombination:

Sub RemedyPartialItalics() 
Dim WdDoc As Word.Doc 
Dim WdFnd As Word.Find 
Dim WdRng As Word.Range 
Dim WdSlct As Word.Selection 
Set WdDoc = ActiveDocument 
    For Each WdRng In WdDoc.StoryRanges 
     wdRng.Select 
     Set WdSlct = Selection 
      WdSlct.SetRange 0, 0 
      Set WdFnd = WdSlct.Find 
       WdFnd.ClearAllFuzzyOptions 
       WdFnd.ClearFormatting 
       WdFnd.ClearHitHighlight 
       WdFnd.Font.Italic = True 
       Do Until Not WdFnd.Execute(FindText:="?", MatchWildcards:=True, Forward:=True, Wrap:=wdFindStop, Format:=True, Replace:=wdReplaceNone) 
        WdSlct.Expand wdWord 
        WdSlct.Font.Italic = True 
        WdSlct.SetRange WdSlct.End, WdSlct.End 
       Loop 
      Set WdFnd = Nothing 
     Set WdSlct = Nothing 
    Next 
End Sub