PPT VBA小白入门之5段有代表性代码

整个Office系列软件都可以支持VBA二次开发，应当说，EXCEL对VBA支持最好，其次是Word，对于PPT来说，支持是较差的。

首先PPT不支持录制宏操作（Excel、Word支持），其次，提供的对象的属性成员和成员方法也很欠缺。

正如excel中有Excel(Application)→Workbook→Worksheet→Range这样的父子层次关系对象一样。

ppt也有PowerPoint(Application)→Presentation→Slide→shape这样的父子层次关系对象。

弄懂了其对象的层次关系，并大致了解各对象的属性和方法，就可以写PPT VBA代码了。

1 对象声明与删除

Sub 段落缩进和字体设置()
    'On Error Resume Next
    '对象和变量声明，要有声明才有代码提示
    Dim oPres As Presentation   ' PPT
    Dim oSlide As Slide         ' 幻灯片
    Dim oShape As Shape         ' 形状对象
    Dim tr As TextRange         ' 文本框
    Dim i As Long, j As Long
    Dim k As Integer            '当前幻灯片索引号
    
    Set oPres = Application.ActivePresentation
    k = Application.ActiveWindow.View.Slide.SlideNumber
    For Each oShape In oPres.Slides(k).Shapes
         oShape.TextFrame2.TextRange.Paragraphs.ParagraphFormat.LeftIndent = 0 ' 段落缩进
         Set tr = oShape.TextFrame.TextRange
         tr.Font.Size = 24
    Next

    Set tr = Nothing '对象删除
    Set oShape = Nothing
    Set oSlide = Nothing
    Set oPres = Nothing
End Sub

2 遍历全部幻灯片及每一个幻灯片的形状对象

' 遍历全部幻灯片及每一个幻灯片的形状对象
    Set oPres = Application.ActivePresentation
    For Each oSlide In oPres.Slides
        For Each oShape In oSlide.Shapes
            With oShape     '设置文本框的宽度和位置，适合只有一个文本框的，
                                     '如果有多个，下面三行代码要注释掉，不然重叠到一起了
                .Left = 45
                .Top = 45
                .Width = 625
                .TextFrame.TextRange.IndentLevel = 1
            End With
        Next
    Next

3 文本框TextFrame设置

    Set oPres = Application.ActivePresentation
    Dim k As Integer '当前幻灯片索引号
    k = Application.ActiveWindow.View.Slide.SlideNumber

    Set oSlide = oPres.Slides.Item(k)
    For j = 1 To oSlide.Shapes.Count
        Set oShape = oSlide.Shapes.Item(j)
        oShape.Left = 24
        With oShape.TextFrame
             .WordWrap = msoTrue
             .AutoSize = ppAutoSizeNone
             .MarginLeft = 0
             .MarginRight = 0
             .MarginTop = 0
             .MarginBottom = 0
             .TextRange.ParagraphFormat.Alignment = ppAlignLeft
             .TextRange.ParagraphFormat.SpaceWithin = 1.3 '行高
             .TextRange.ParagraphFormat.SpaceBefore = 0 '段前
             .TextRange.Font.Size = 24
         End With
   Next

4 文本框段落设置

    Set oPres = Application.ActivePresentation
    k = Application.ActiveWindow.View.Slide.SlideNumber
    For Each oShape In oPres.Slides(k).Shapes
    'oShape = oPres.Slides(k).Shapes
            
        With oShape.TextFrame.TextRange.ParagraphFormat
            .SpaceWithin = 1.2 '设置行距
            .Alignment = ppAlignLeft
        End With
        
        With oShape.TextFrame2.TextRange.Paragraphs.ParagraphFormat
            .LeftIndent = 0 ' 段落缩进
        End With
    Next

5 段落字体设置

    Set oPres = Application.ActivePresentation
    k = Application.ActiveWindow.View.Slide.SlideNumber
    For Each oShape In oPres.Slides(k).Shapes
        If oShape.TextFrame.HasText = msoTrue Then
             Set tr = oShape.TextFrame.TextRange
             With tr.Font
                 .NameAscii = "宋体"
                 .NameFarEast = "宋体"
                 .Size = 18
                 .Color.SchemeColor = ppBackground
                 .Color.RGB = RGB(Red:=0, Green:=0, Blue:=0)
                 .Bold = msoFalse
                 
             End With
             tr.ParagraphFormat.SpaceWithin = 1.1 '设置行距
             Set tr = Nothing
        End If

－End－