|
|
PPT vba入门教程
1.Application对象
该对象代表PowerPoint应用程序，通过该对象可访问PowerPoint中的其他所有对象。
(1)Active属性：返回指定窗格是否被激活。
(2)ActivePresentation属性：返回Presentation对象，代表活动窗口中打开的演示文稿。
(3)ActiveWindow属性：返回DocumentWindow对象，代表当前文档窗口。
(4)Presentations属性：返回Presentations集合，代表所有打开的演示文稿。
(5)SlideShowWindows属性：返回SlideShowWindows集合，代表所有打开的幻灯片放映窗
口。
(6)Quit方法：用于退出PowerPoint程序。
2.DocumentWindow对象
该对象代表文档窗口。使用“Windows(index)”语法可返回DocumentWindow对象。
(1)ActivePane属性：返回Pane对象，代表文档窗口中的活动窗格。
(2)Panes属性：返回Panes集合，代表文档窗口中的所有窗格。
(3)ViewType属性：返回指定的文档窗口内的视图类型。[NextPage]
3.Presentation对象
该对象代表演示文稿，通过“Presentations(index)”语法可返回Presentation对象。
(1)BuiltInDocumentProperties属性：返回DocumentProperties集合，代表演示文稿的所有文
档属性。
(2)ColorSchemes属性：返回ColorSchemes集合，代表演示文稿的配色方案。
(3)PageSetup属性：返回PageSetup对象，用于控制演示文稿的幻灯片页面设置属性。
(4)SlideMaster属性：返回幻灯片母版对象。
(5)SlideShowSettings属性：返回SlideShowSettings对象，代表演示文稿的幻灯片放映设置。
(6)SlideShowWindow属性：返回幻灯片放映窗口对象。
(7)AddTitleMaster方法：为演示文稿添加标题母版。(8)ApplyTemplate方法：对演示文稿应用设计模板。
4.SlideShowWindow对象:该对象代表幻灯片放映窗口。
IsFullScreen属性：用于设置是否全屏显示幻灯片放映窗口。[NextPage]
5.Master对象：该对象代表幻灯片母版、标题母版、讲义母版或备注母版。
TextStyles属性：为幻灯片母版返回TextStyles集合，代表标题文本、正文文本和默认文本。
6.Slide对象:该对象代表幻灯片。
(1)SlideID属性：返回幻灯片的唯一标识符。
(2)SlideIndex属性：返回幻灯片在Slides集合中的索引号。
7.SlideShowView对象:该对象代表幻灯片放映窗口中的视图。
(1)AcceleratorsEnabled属性：用于设置是否允许在幻灯片放映时使用快捷键。
(2)CurrentShowPosition属性：返回当前幻灯片在放映中的位置。
(3)DrawLine方法：在指定幻灯片放映视图中绘制直线。
(4)EraseDrawing方法：用于清除通过DrawLine方法或绘图笔工具在放映中绘制的直线。
(5)GotoSlide方法：用于切换指定幻灯片。
powerpoint学习笔记
转自：http://www.rdpslides.com/pptlive/index.html
Sub PowerPointBasics_1()
'PowerPoint的对象模型Ojbect Model(OM)
'模型导航
'每个东东在PowerPoint中都是某个类型的对象
'想操作好PowerPoint，你就要和对象打交道
'有些对象是另外一些对象的集合。
'对象具有属性–用来描述对象的东东
'对象具有方法–对象可以做或你可以对他做什么
'对象模型就是所有PowerPoint对象自成一个体系的集合
'就像一个倒置的树图
'按F2浏览查看对象
'数的最顶层是应用对象（Application）
'就是PowerPoint本身
'应用对象有他的属性
Debug.Print Application.Name
'用Debug.Print代替MsgBox能节省一点时间'我们就不需要点击对话框的“确定”按钮
'Debug.Print的结果输出在VB编辑器环境中的立即窗口中
'如果它没有显示，通过点击菜单“视图”/“立即窗口”或者按Ctrl+G来显示
'.Presentations属性返回当前打开演示文档的一个集合
'我们通过“点”提示来调用它的功能
Debug.Print Application.Presentations.Count
'我们可以指定一个特定的对象
Debug.PrintApplication.Presentations(1).Name
'所以说PowerPoint(即application对象)包含Presentations对象
'Presentations包含Slides对象
'Slides包含Shapes对象，如rectangles和circles。
'所以我们可以自然的这样写:
Debug.PrintApplication.ActivePresentation.Slides(2).Shapes.Count
'但是这么长的引用有些令人乏味
'另一种形式对我们来说更容易一些同时也会让PowerPoint处理的更快一些
'使用With关键字来引用你用的对象..
With ActivePresentation.Slides(2).Shapes(2)
'这样你可以直接引用他的下级功能Debug.Print.Name
Debug.Print.Height
Debug.Print.Width
'最后用End With关键字来表明引用完毕
End With
'我们也可以嵌套着使用
With ActivePresentation.Slides(2).Shapes(2)
Debug.Print.Name
With.TextFrame.TextRange
Debug.Print.Text
Debug.Print.Font.Name
End With
End With
End Sub
Sub PowerPointBasics_2()'控制当前选中的对象
With ActiveWindow.Selection.ShapeRange(1)
Debug.Print.Name'显示对象的名字
End With
'更改名字并移动他:
With ActiveWindow.Selection.ShapeRange(1)
.Name="My favorite shape"'命名对象非常有用
.Left=.Left+72'72像素即1英寸
End With
End Sub
Sub PowerPointBasics_3()
'控制一个已命名的对象，如果你知道一个对象的名字
WithActivePresentation.Slides(2).Shapes("My favorite shape")
.Top=.Top-72
EndWith'每页幻灯片也可以有名字
WithActivePresentation.Slides(2)
.Name="My favorite slide"
EndWith
'无论我们移动他到那个地方，名字不变
'这样我们就可以方便的操作啦
With ActivePresentation.Slides("My favoriteslide").Shapes("My favorite shape")
.Height=.Height*2
End With
End Sub
Sub PowerPointBasics_4()
'对象的引用
'可以通过变量来保持对对象的引用
'可能会有些难于理解，不过不用担心
'参照实例很容易理解的。
'先看下面的例子：'定义一个变量为某个类型
Dim oShape As Shape
'让他指向某个特定的对象
SetoShape=ActivePresentation.Slides("My favorite slide").Shapes("Myfavorite shape")
'注意我们使用已命名的对象。
'从现在开始，我们就可以把oShape认作为我们命名的那个对象。
Debug.PrintoShape.TextFrame.TextRange.Text
oShape.TextFrame.TextRange.Font.Color.RGB=RGB(255,0,0)
'直到我们删除这个变量，都可以认为他就是我们命名的那个对象。
SetoShape=Nothing
End Sub
Sub PowerPointBasics_5()
'遍历所有的幻灯片
'遍历所有的对象
Dim x As Long'使用X作为计数器
Forx=1 To ActivePresentation.Slides.Count'遍历每张幻灯片并打印名字
Debug.Print ActivePresentation.Slides(x).Name
Nextx
WithActivePresentation.Slides(3)
For x=1 To.Shapes.Count'打印出第三个片上所有图片的名字；
Debug.Print.Shapes(x).Name
Next x
End With
End Sub
Sub PowerPointBasics_6()
'处理异常错误
'运行下，看看会出现什么现象？
WithActivePresentation.Slides(42)
MsgBox("Steve,you moron,there IS no slide 42!")
EndWith
End Sub
Sub PowerPointBasics_6a()
On Error GoTo ErrorHandler '设置错误跳转句柄；
WithActivePresentation.Slides(42)
MsgBox("Steve,you moron,there IS no slide 42!")
EndWith
'后面带有冒号标志的为句柄代码；
'如果无误，则能进行到这里
'句柄代码：
NormalExit:
ExitSub
ErrorHandler:’此处即为句柄代码
MsgBox("Error:"&Err.Number&vbCrLf&Err.Description)
'resumenext
'exitsub
ResumeNormalExit
End Sub
Option Explicit
Public strText As String
Public strOption As String
Sub Forms_1()
'创建、显示和卸载窗体；
'窗体是比普通的输入窗口更为复杂的东西。如：
frmMyForm1.Show
Debug.PrintfrmMyForm1.TextBox1.Text
IffrmMyForm1.OptionButton1.Value=True Then
Debug.Print"Yes"End If
If frmMyForm1.OptionButton2.Value=True Then
Debug.Print"Chocolate"
End If
If frmMyForm1.OptionButton3.Value=True Then
Debug.Print"Teal"
End If
'下面是卸载窗体
Unload frmMyForm1
'但是如果我们想让窗体数据用更久该怎么做？让数据留在窗体中岂不是更有意义？
End Sub
Sub Forms_2()
‘这个例子中使用了全局变量，所以窗体中的数据能一直保持。
Unload frmMyForm2
'让我们看看用户在窗体中指定的值：
'为窗体指定的代码：
Debug.Print strText
Debug.Print strOption
'重复利用代码
'我们可以将窗体输出为一个文件并引入到其他工程中。
End Sub
下面是有关动画技巧的代码：
Option Explicit
'告诉VBA如何调用sleep函数的API
'此函数让VBA停顿数毫秒：
Private Declare Sub SleepLib"kernel32"(ByVal dwMilliseconds As Long)
Sub xYouClicked(oSh As Shape)
Dim oShThought As Shape
SetoShThought=oSh.Parent.Shapes("Thought")
'使Thought气球可见；
oShThought.Visible=True
'移动到被点击图形的右侧；
oShThought.Left=oSh.Left+oSh.Width
'垂直置于被点击图像的上方
oShThought.Top=oSh.Top-oShThought.Height
SelectCase UCase(oSh.Name)
Case Is="EENIE"
oShThought.TextFrame.TextRange.Text="est!"
Case Is="MEENIE"
oShThought.TextFrame.TextRange.Text="Thisis annoying!"
Case Is="MINIE"
oShThought.TextFrame.TextRange.Text="Thisis REALLY annoying!!"Case Is="MOE"
oShThought.Visible=False
oSh.Parent.Shapes("STOP").Visible=True
End Select
End Sub
Sub yYouClicked(oSh As Shape)
'这一次我们将使用标签，使其更易于维护
Dim oShThought As Shape
SetoShThought=oSh.Parent.Shapes("Thought")
'使气球可见并移动到我们点击的图像处。
oShThought.Visible=True
oShThought.Left=oSh.Left+oSh.Width
oShThought.Top=oSh.Top-oShThought.Height
'使用标签来收集文本
oShThought.TextFrame.TextRange.Text=oSh.Tags("Thought")
End Sub
Sub AddATag()
'Alittle macro to add a tag to the selected shape
Dim strTag As String
'我们的老伙计输入框获取标签文本...
strTag=InputBox("Typethe text for the thought balloon","What is the shape thinki
'如果输入为空则退出。'必须输入东西，否则无法为图像添加标签。
IfstrTag=""Then
Exit Sub
EndIf
WithActiveWindow.Selection.ShapeRange(1)
.Tags.Add"Thought",strTag
EndWith
End Sub
Sub YouClicked(oSh As Shape)'现在为其增加个API的停顿使其过渡的更平滑自然。
Dim oShThought As Shape
SetoShThought=oSh.Parent.Shapes("Thought")
'使用标签来提取文本
oShThought.TextFrame.TextRange.Text=oSh.Tags("Thought")
'使气球可见并移动到我们点击的图像处。
oShThought.Left=oSh.Left+oSh.Width
oShThought.Top=oSh.Top-oShThought.Height
oShThought.Visible=True
DoEvents'将控制权交给系统。常用与for循环或do…loop循环中。
Sleep1000'等待1秒；
oShThought.Visible=False'使其重新不可见
End Sub
Sub Reset()
'重设我们的陷阱，为下一个粗心的用户做准备；
ActivePresentation.Slides("AnimationTricks").Shapes("STOP").Visible=Fa
ActivePresentation.Slides("AnimationTricks").Shapes("Thought").Visible=
End Sub
Option Explicit
Sub GreenToRed() '绿色转红色
Dim oSh As Shape'幻灯片的对象变量
Dim oSl As Slide
ForEach oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
If oSh.Fill.ForeColor.RGB=RGB(0,255,0) Then
oSh.Fill.ForeColor.RGB=RGB(255,0,0)
End If
Next oSh
NextoSl
End Sub
Sub FolderFull()
'对于符合我们要求的文件夹中的每个ppt，
'-打开文件，调用过程函数处理；
'保存并关闭文件；
Dim strCurrentFile As String'用于单纯文件名的变量；
Dim strFileSpec As String'用于文件扩展名的变量；
strFileSpec="C:\Documentsand
Rindsberg\Desktop\PPTLive\Automation\LotsOfFiles\*.ppt"'获取符合要求的第一个文件；
strCurrentFile=Dir$(strFileSpec)
'如果未找到符合条件的文件则什么也不做；
WhileLen(strCurrentFile)>0'持续这一过程，直至再也找不到文件；
Presentations.Open(strCurrentFile)'打开ppt
Debug.PrintActivePresentation.Name 可通过修改这句来调用其他的函数，可用同样的代码做其他的任务；
CallGreenToRed ’调用GreenToRed函数；
ActivePresentation.SaveAs(ActivePresentation.Path&"\"_
&"Fixed_"&ActivePresentation.Name)'保存成带FIXED_前缀的新名称；
'关闭ppt并处理下一个符合条件的文件；
'如果你不提供新的扩展名,Dir$将会返回符合上前一个要求的文件；
strCurrentFile=Dir$
Wend
注意不要在循环代码中使用dir【此处翻译可能有问题'Note don't use Dir incode that's called from within a loop】，使用时只能是一个Dir，而且一会激活一次。在产品代码中，最好是用于一个非常短的循环或者在一个短的循环中收集文件名，然后使用更有用的数组来处理；
End Sub
Option Explicit
Sub FolderFullFromArray()'使用数组来收集文件名进行处理
'这比在循环中使用dir处理文件名更加可靠
Dim rayFileNames()As String
Dim strCurrentFile As String'代表文件名的变量
Dim strFileSpec As String'代表扩展名的变量
'给出一个在计算机能正常应用的路径值
strFileSpec="C:\Documentsand
Rindsberg\Desktop\PPTLive\Automation\LotsOfFiles\*.ppt"
ReDimrayFileNames(1 To 1)As String'重定义数组维数为1
strCurrentFile=Dir$(strFileSpec)'获取符合我们要求的第一个文件
WhileLen(strCurrentFile)>0
rayFileNames(UBound(rayFileNames))=strCurrentFile'添加到数组
strCurrentFile=Dir'重定义数组维数
ReDimPreserve rayFileNames(1 To UBound(rayFileNames)+1)As St
Wend
'如果没有文件了，数组只有一个元素，如果还有更多的元素，则最后一个为空
IfUBound(rayFileNames)>1 Then'去掉最后一个空元素
ReDim Preserve rayFileNames(1 To UBound(rayFileNames)-1)As St
Else
'没有找到文件
Exit Sub
EndIf'如果运行到了这里，则我们已经收集好了文件名数组
Dim x As Long
Forx=1 To UBound(rayFileNames)
Presentations.Open(rayFileNames(x)) '打开ppt文件
Debug.Print ActivePresentation.Name
Call GreenToRed'调用过程函数
ActivePresentation.SaveAs(ActivePresentation.Path&"\"&"Fixed_"& ActivePresentation.Name)
ActivePresentation.Close
Nextx
End Sub
这是从宏录制的演示代码，录制宏是对于新手很容易掌握和学习ppt对象模型是如何运作的，但是其不会产生很有用的代码。这表明要获取非常有用的代码，还需要自己去对其进行修改和整理。假设共同的颜色都由绿色转为了红色，有数百个这样填充的ppt需要设置为原来的绿色，首先，你打开一个ppt，选择一个图形，将其颜色由绿色变为红色，并录制了一个宏，到这里结束：
Sub Macro1()
ActiveWindow.Selection.SlideRange.Shapes("Rectangle5").Select
WithActiveWindow.Selection.ShapeRange
.Fill.Visible=msoTrue
.Fill.ForeColor.RGB=RGB(255,0,102)
.Fill.Solid
EndWith
ActivePresentation.ExtraColors.AddRGB(Red:=255,Green:=0,Blue:=102)
End Sub
但是存在一些问题：它仅仅适用于当前的一张有一个名字为"Rectangle 5"的图形的ppt，仅仅改变这个图形，没有其他的改变如透明度填充，可见性等。而且为ppt调色板增加了额外的颜色。总之，只是改变了当前页ppt的当前的图形的颜色从绿变红。仅仅如此。而且在这个过程中还创设了潜在的一些问题。然而其却向我们展示了如何用VBA代码去改变一个图形的颜色，所以也并不是全无用处。让我们看看能否让其变成更加通用的东西。选择绿色的图形，再录制一个宏，将其改变为红色。
Sub Macro2()
WithActiveWindow.Selection.ShapeRange.Fill.ForeColor.RGB=RGB(255,0,102)
.Fill.Visible=msoTrue
.Fill.Solid
EndWith
End Sub
这个更好了，好多了，在任何选定的图形，而且事实上在多个选定的图形上都适用。它仍旧设置了一些额外的我们不需要的属性，不过我们可以将这些东西都注释掉。你可以在任何一页ppt上选择所有图形来运行这个宏，不过，最好不要那样做，因为其不仅会将绿色，还会将蓝色、紫色等其他颜色的图形统统变为红色。因此你需要逐张ppt遍历，去选定所有绿色的图形并一遍又一遍的运行这个宏。这些就够了。下面就是你和其他的VBA高手所做的东西：
Sub GreenToRed()
Dim oSh As Shape
Dim oSl As Slide
ForEach oSl In ActivePresentation.Slides'在当前ppt查找每张幻灯片:
For Each oSh In oSl.Shapes'在每张幻灯片查找每个图形
If oSh.Fill.ForeColor.RGB=RGB(0,255,0)Then'如果图形的填充颜色=纯绿色，就改变其为红色
oSh.Fill.ForeColor.RGB=RGB(255,0,0)
End If
Next oSh
NextoSl
End Sub
哈哈，弹指之间，数百个ppt中数千的图形的颜色实现了由绿色变为了红色。而且仅仅是改变了我们目标中的绿色图形，而不改变其他的颜色的图形。对带有文本的情况是安全的吗？并非所有的图形内都有文本，如果你试图去访问其中的一个文本属性，ppt将会弹出错误。此外，ppt97创建的文本会出现冲突，虽然它们有保留文本的能力，但当你试图去检查其中的文本时会出现错误。下面是个安全检查函数，用于测试所有可能引发错误的情况，如果没有任何错误，则返回值为Ture。
Public Function IsSafeToTouchText(pShape AsShape)As Boolean
On Error GoTo Errorhandler
IfpShape.HasTextFrame Then
If pShape.TextFrame.HasText Then
If Len(pShape.TextFrame.TextRange.text)>0 Then'若果是个假的形状这里将出现错误
IsSafeToTouchText=True'安全的情况
Exit Function
End If '长度>0
End If '存在文本
EndIf '存在文本框
Normal_Exit:
IsSafeToTouchText=False
ExitFunction
Errorhandler:
IsSafeToTouchText=False
ExitFunction
End Function
加载宏PPA文件的路径是什么？如果你需加载额外的加载行，你可能需要将它们放进加载宏的文件夹。但是它在哪里呢？用户可能会从本地磁盘或网络驱动器去安装加载项，因此你不确定加载项和相关的文件到底在哪里。至少不是没有这种情况：
Public Function PPAPath(AddinName asString)As String
返回找到的加载项的路径，斜杠结尾，没有找到则返回空
Dim x AsInteger
PPAPath=""
For x=1 ToApplication.AddIns.count
If UCase(Application.AddIns(x).Name)=UCase(AddinName)Then
PPAPath=Application.AddIns(x).path&GetPathSeparator'我们找到了
'不需要去检查其他的加载项
Exit Function
End If
Nextx
'因此我们从ppt的IDE中运行，而非从PPA中:
IfPPAPath=""Then
PPAPath=SlashTerminate(ActivePresentation.path)
EndIf
End Function
到此算是翻译完了。讲的都是比较简单的ppt的遍历的用法。其实个人认为，ppt的精髓——动画部分的VBA才真正是麻烦的和高级的东西。不过作为入门，这个应该是很有帮助的。 |
|
