VBA將PPT中有顏色的文本內(nèi)容全部改為粗體

VBA將PPT中有顏色的文本內(nèi)容全部改為粗體

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
 
 ‘m.mzhfr.cn                  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 "處理完畢！"