代码设置margintop_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 = NothingEnd 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－