Question

我创建了一个宏来替换文本中的所有字符，从旧的转录字体到unicode字体。我不知道为什么，但有些字符会保留原始格式，而其他字符会丢失格式（在我的情况下，主要是斜体），通常在同一个单词中。这留给我很多单词，其中一些字母是斜体，而其他字母则不是（例如，“ al-Malik al-Mu ǧāhidḫuṭ< EM> 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）的编辑请求

为了使这个工作在脚注，标题和其他故事范围内，我通过将其与this trick相结合来改编Gary的解决方案：

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

MS Word宏来纠正部分格式化的单词

1 个答案: