PowerPoint VBA参考代码库2

'遍历当前演示文档中的每一张幻灯片
Dim pptSlide As Slide
Dim pptShape As Shape
For Each pptSlide In ActivePresentation.Slides
 '对幻灯片的操作代码
Next

'遍历当前幻灯片中所有形状
Dim pptSlide As Slide
Dim pptShape As Shape
Set pptSlide = Application.ActiveWindow.View.Slide
For Each pptShape In pptSlide.Shapes
 '对形状的操作代码
Next

'遍历当前演示文档的所有幻灯片中的所有形状
Dim pptSlide As Slide
Dim pptShape As Shape
For Each pptSlide In ActivePresentation.Slides
 For Each pptShape In pptSlide.Shapes
 '对形状的操作代码
 Next pptShape
Next pptSlide

'取消所有链接
ActivePresentation.BreakLinks
'更新所有链接
ActivePresentation.UpdateLinks
形状链接：
'取消指定链接的形状的链接
pptShape.LinkFormat.BreakLink
'更新对指定链接的形状的链接
pptShape.LinkFormat.UpdateLink
'将链接类型修改为手动更新
pptShape.LinkFormat.AutoUpdate = ppUpdateOptionManual
'将链接类型修改为自动更新
pptShape.LinkFormat.AutoUpdate = ppUpdateOptionAutomatic
'将链接修改为转到新的源文件
pptShape.LinkFormat.SourceFullName = "C:\完美Excel\test.xlsx!Sheet1"

'创建形状并赋值给变量
Dim pptSlide As Slide
Dim pptShape As Shape
Set pptSlide = Application.ActiveWindow.View.Slide
Set pptShape = pptSlide.Shapes.AddShape(Type:=msoShapeRectangle, _
 Left:=50, Top:=50, Width:=50, Height:=50)
'命名形状
pptShape.Name = "myShape"
'显示所选形状的大小
Dim msgText As String
msgText = "Top: " & ActiveWindow.Selection.ShapeRange.Top & vbNewLine
msgText = msgText & "Left: " & ActiveWindow.Selection.ShapeRange.Left
& vbNewLine
msgText = msgText & "Height: " &
ActiveWindow.Selection.ShapeRange.Height & vbNewLine
msgText = msgText & "Width: " & ActiveWindow.Selection.ShapeRange.Width
& vbNewLine
MsgBox msgText