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-