MS Word宏，用于更正部分格式化的文字

Question

我制作了一个宏，用于替换文本中的所有字符，从旧的转录字体到unicode字体。我不知道为什么，但一些字符保持原始格式，而其他字符通常在同一个单词中失去格式（在我的情况下，大部分是斜体）。这给我留下了很多单词，其中一些字母是斜体，而其他字母不是（例如，“al-Malik al-Muǧāhidḫuṭba”）。失去格式的字符都是带有变音符号的字符，但并非所有带变音符号的字符都会丢失格式（例如，示例中的ḫ）。

找到至少有一个字母为斜体的所有单词并将斜体格式应用于所有这些单词的最佳方法是什么？

如果有人能指出我对原始问题的解决方案，那当然会更好（但这是另一个问题的主题：some characters lose formatting in vba macro others don't）。

Answer 1

下面的代码回答了

我添加注释来描述发生了什么“格式化所有的这些话会发现有斜体至少有一个字母的所有单词，并应用斜体”的问题。我自动化Word很多，我发现它有很多怪癖，所以下面的工作是在一个简单的测试，但你应该彻底测试，然后释放代码到野外。

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 

---

从编辑请求改编自@peterv（在OP）

要在脚注，页眉和其他storyranges这项工作，我适应通过与this trick结合加里的解决方案：

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