如何用vba批量修改ppt幻灯片的字体格式?

用vba设置ppt的幻灯片的字体名称与用vba设置excel或者word的字体名称有些不同。

当要设置幻灯片的字体时,Font对象提供了以下5个设置字体名称的属性:

Name 属性用于返回或者设置Font对象的名称,一般用于从集合中返回单个对象。

NameAscii属性返回或设置用于 ASCII 字符的字体(字符集编号在 0 到 127 范围内的字符)。

NameFarEast属性返回或设置亚洲字体名称。

NameComplexScript返回或设置复杂文种字体名称。用于混合语言文本

NameOther属性返回或设置字符集编号大于 127 的字符所用的字体

为了让所有字符都用统一的字体,用vba设置ppt的幻灯片的字体名称时可以将以上属性都设置为统一值。

Sub QQ1722187970()
    '形状对象
    Dim oShape As Shape
    '幻灯片对象
    Dim oSlide As Slide
    '返回文本区域对象
    Dim oRng As TextRange
    Dim oTable As Table
    Dim oCell As Cell
    Dim oPPT As Presentation
    Set oPTT = PowerPoint.ActivePresentation
    With oPTT
        For Each oSlide In .Slides
            With oSlide
                For Each oShape In .Shapes
                    With oShape
                        If .HasTextFrame Then
                            Set oRng = .TextFrame.TextRange
                            With oRng.Font
                                 .Color = vbRed
                            End With
                        End If
                        If .HasTable Then
                            Set oTable = .Table
                            With oTable
                                iCol = .Columns.Count
                                iRow = .Rows.Count
                                For i = 1 To iRow
                                    For j = 1 To iCol
                                        Set oRng = .Cell(i, j).Shape.TextFrame.TextRange
                                        With oRng.Font
                                            .Color = vbRed
                                        End With
                                    Next j
                                Next i
                            End With
                        End If
                        If .Type = msoGroup Then
                        Set oShapes = .GroupItems
                        For Each oShape1 In oShapes
                            With oShape1
                                 If .HasTextFrame Then
                            Set oRng = .TextFrame.TextRange
                            With oRng.Font
                                 .Color = vbRed
                            End With
                        End If
                        If .HasTable Then
                            Set oTable = .Table
                            With oTable
                                iCol = .Columns.Count
                                iRow = .Rows.Count
                                For i = 1 To iRow
                                    For j = 1 To iCol
                                        Set oRng = .Cell(i, j).Shape.TextFrame.TextRange
                                        With oRng.Font
                                            .Color = vbRed
                                        End With
                                    Next j
                                Next i
                            End With
                        End If
                            End With
                        Next
                        End If
                    End With
                Next
            End With
        Next
    End With
End Sub

其中以上代码中的PresentationSlideTextFrameTextRange都是ppt中的常用对象。

       

仅有1条评论 发表评论

  1. 张品 /

    请问 如何在2016版ppt中使用VBA代码批量设置文本框中字符间距

发表评论