VBA将ppt保存为html,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 "处理完毕！"