vba ppt 遍历每个字符颜色并做批处理

 ppt 宏遍历每个字符的颜色(红色加下划线,蓝色变斜体)

Sub ReplaceColor()
Dim shape As shape
Dim slide As slide
Dim txt As TextRange
On Error Resume Next
For Each slide In ActivePresentation.Slides
   For Each shape In slide.Shapes
      Set txt = shape.TextFrame.TextRange
      For Each sentence In txt.Sentences
        For Each word In sentence.Words
          If word.Font.Color.RGB = RGB(60, 14, 254) Then  '如果字符颜色=rgb(60,14,254)时
            With word.Font
              .Name = "新宋体"
              .Size = 20
              .Italic = True
              .Bold = Not True
            End With
          End If
          If word.Font.Color.RGB = RGB(255, 0, 0) Then
            With word.Font
              .Name = "Arial"
              .Underline = True
              .Bold = True
              .Italic = Not True
            End With
          End If
        Next
      Next
   Next
Next
End Sub