VBA将PPT中有颜色的文本内容全部改为粗体

VBA将PPT中有颜色的文本内容全部改为粗体

On Error Resume Next


'''''''''''''''''''''''''''''''''''''''''开始取消组合'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

For i = 1 To ActivePresentation.Slides.Count
    For Each shp In Application.ActivePresentation.Slides(i).Shapes
    
        If shp.Type = msoGroup Then
            shp.Ungroup
        End If
    Next
Next
    

'''''''''''''''''''''''''''''''''''''''''以下开始对加粗字体'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim myshp As Shape
'tmtony 
For i = 1 To ActivePresentation.Slides.Count
    For k = 1 To Application.ActivePresentation.Slides(i).Shapes.Count
        Set myshp = Application.ActivePresentation.Slides(i).Shapes(k)
        nm = Application.ActivePresentation.Slides(i).Shapes(k).Name  '14 msoPlaceholder  17为文本框   msoAutoShape 1  'msoInkComment = 23  22  13为图片  msoLine = 9
          
 
        If myshp.Type = 1 Or myshp.Type = 14 Or myshp.Type = 17 Then
           
            For j = 1 To Len(Application.ActivePresentation.Slides(i).Shapes(k).TextFrame.TextRange.Text)
         
                If Application.ActivePresentation.Slides(i).Shapes(k).TextFrame.TextRange.Characters(Start:=j, Length:=1).Font.Color.RGB <> RGB(Red:=255, Green:=255, Blue:=255) Then
 
 ‘www.office-cn.net                  Application.ActivePresentation.Slides(i).Shapes(k).TextFrame.TextRange.Characters(Start:=j, Length:=1).Font.Bold = msoTrue
                End If
            Next
        End If

    Next k
Next i
MsgBox "处理完毕！"