kerrypnx
8/23/2018 - 8:35 AM

检测字体字号

revise 9-12

Sub diff_fontName_size()
On Error Resume Next
    Dim p As paragraph
    Dim a As Integer
    Dim d As Document
    Set d = ActiveDocument
    Dim wrd As Range
    Dim i As Integer
    i = 1
    With d.Range(0, 0)
        Do While .End < d.Content.End - 1
            If .Information(12) Then
                .Expand 15
                .Move
            Else
                If .Paragraphs(1).Range.Font.name <> "Palatino Linotype" Then
                    For Each wrd In .Paragraphs(1).Range.Words
                        If wrd.Font.name <> "Palatino Linotype" Then
                            wrd.Select
                            Selection.MoveRight wdCharacter, 1
                           
                            If Selection.Type = 2 Then
                           wrd.HighlightColorIndex = wdRed
                           End If
                        End If
                    Next
                End If
                If .Paragraphs(1).Range.Font.Size = 9 Or .Paragraphs(1).Range.Font.Size = 10 Or .Paragraphs(1).Range.Font.Size = 18 Then
                Else
                    For Each wrd In .Paragraphs(1).Range.Words
                        If i <> 1 And wrd.Font.Size <> wrd.Previous(wdWord, 1).Font.Size Then ' i <>1 解决第一个单词背高亮的问题
                        wrd.Select
                          Selection.MoveRight wdCharacter, 1
                            If Selection.Type = 2 Then
                                wrd.HighlightColorIndex = wdRed
                            End If
                        End If
                    i = i + 1
                Next
            End If
        End If
        .Move 4                         '指针指向下一个段落首地址
    Loop                                      '循环到Do开始
End With
End Sub