用VBA去操作PowerPoint

1.       获取当前Presenation的名字

Sub NameThisPres()

MsgBox Windows(1).Presentation.Name

        End Sub

2.       显示当前Presentation上所有的Placeholder.

    Sub EachObject()

        Dim oshapes As Object

        Dim ph As Object

        Dim Oslide As Object

       

        With ActiveWindow.Selection.SlideRange.Shapes

            Set Oslide = ActiveWindow.Selection.SlideRange(1)

            For Each ph In Oslide.Shapes.Placeholders  ‘遍历所有其中的元素

                MsgBox ph.Name

            Next ph

        End With

 

                   ActiveWindow.S

End Sub

3.       打开一个模板，并进行相应的设置

    Presentations.Open FileName:="E:/tempfiles/Tempo.potx", Untitled:=msoTrue    '应用一个模板, 注msoTrue即True.

   

    ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=1, Layout:=ppLayoutTitle).SlideIndex   '添加一个新的slide,并应用新的Layout

   

    ActiveWindow.Selection.SlideRange.Shapes(1).Select '选择第一个元素，也可以用名字来进行填入查找

   

    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select   '选择这个元素的Text.

   

    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select  '选择一段字

   

        With ActiveWindow.Selection.TextRange   '选择这个字Selection

            .Text = "TTTT of the new presentatioin"   '设置其Text参数

            With .Font    '设置这个对象中的各个属性值

                .Name = "Times New Roman"

            End With

        End With

 

4.       设置某个PlaceHolder的字体及内容

Sub TestText()

   

    ActiveWindow.Selection.SlideRange.Shapes(2).Select   '选择第二个shape

        ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select   '选择其字体输入体

        ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select  '选择其中的字体

        With ActiveWindow.Selection.TextRange  '然后准备在其中进行设置

            .Text = "HHHHHH" + Chr$(CharCode:=11) + "Secodn" '对上面的这个对象设置内容 Chr（）为字符转换方法，其中“$（”处的$值得研究，对其中CharCode:=11,或13是指发出的ASCII为回车符或只是换行符

            With .Font   '对上面的对象进行各种设置

                .Name = "Times New Roman"

                .Size = 44

                .Bold = msoTrue

                .Italic = msoFalse

                .Underline = msoFalse

                '.BaselineOffset = 2

            End With

        End With

End Sub

5.       插入图片

ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:="E:/tempfiles/clip_image002.gif", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=30, Height:=60).Select

分析：

ActiveWindow.Selection.SlideRange 指的是当前的幻灯片，

Left:=0, Top:=0, Width:=30, Height:=60 定位和设置大小

PowerPoint定位并不是用像素来实现的，而是用磅测量屏幕。 如果在屏幕上放置一个图片并且通过选择Format Picture去观察它的位置，那么请注意位置是以英寸来确定的。 这时需要一个翻译对照表来确定把图片放于何处。

如果一个图片，规定它的尺寸为1个单位宽及1个单位高，那么把图片放在屏幕的左上角只需要设置成 Left:=0, Top:=0, Width:=1, Height:=1即可。

如果把图片用如下语句

ActiveWindow.Selection.SlideRange.Shape(“Picture 8”).Select

With ActiveWindow.Selection.ShapeRange

         .IncrementLeft 720#

         .IncrementTop 540#

End With

则会把图片放在右下角。

其中720磅宽和540磅高,在进行精确定位时,相当于是72磅对应1英尺, 即10:7.5的屏幕,由此也可以知道, 当前的屏幕的比例, 注:不同的屏幕这个值应当不一样.

所以总结前面的例子,要把一个图片导入进来,并让其居中,用如下语句.

    ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:="E:/tempfiles/clip_image002.gif", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=30, Height:=60).Select

    With ActiveWindow.Selection.ShapeRange

        .IncrementLeft 360#

        .IncrementTop 270#

End With

 

6.       加入WordArt在当前Presentation.

    ActiveWindow.Selection.SlideRange.Shapes.AddTextEffect(msoTextEffect28, "Cap'n the cat" + Chr$(CharCode:=13) + "MouseCatcher", "Impact", 36#, msoFalse, msoFalse, 10, 10).Select

    With ActiveWindow.Selection.ShapeRange

End With

7.       设置动画控件

    ActiveWindow.Selection.SlideRange.Shapes(2).Select

    With ActiveWindow.Selection.ShapeRange.AnimationSettings

        .Animate = msoTrue

        .EntryEffect = ppEffectFlyFromBottom

        .TextLevelEffect = ppAnimateByAllLevels

        .AnimateBackground = msoTrue

End With

8.       设置幻灯片的转换

Sub Wipe_Right()

    With ActiveWindow.Selection.SlideRange.SlideShowTransition

        .EntryEffect = ppEffectWipeRight

        .Speed = ppTransitionSpeedFast

        .AdvanceOnClick = msoTrue

        .AdvanceOnTime = msoTrue

        .AdvanceTime = 3

        .SoundEffect.Type = ppSoundNone

    End With

End Sub

9.       使用控件工具栏

1)         插入一个用户窗体，并命名为UF1.

2)         在这个窗体上添加想要使用的控件。如加入Button, OptionButtion, CheckBox.

3)         并在各个控件上添加相应的响应方法，如下：

Private Sub CheckBox1_Click()

    If CheckBox1.Value = True Then

        MsgBox "I hope here is wind"

    End If

End Sub

 

Private Sub CommandButton1_Click()

    MsgBox "I'm pressed"

End Sub

 

Private Sub OptionButton1_Click()

    If OptionButton1.Value = True Then

        MsgBox "I was selected"

    End If

End Sub

 

4)         然后在Presentation上添加一个object以接收动作，并设置其动作选择刚才编辑的宏命令.

5)         然后运行这个Presentation.

10.   使用项目符号

用VBA去改变在给定的页上的或在Slide Master 上的项目符号格式，要完成这个任务，需要把”从直观上看不很明显”的步骤加到代码上， 这个被记录的代码为项目符号返回某个数值， 例如：

.Character = 61646

这个值本身就不是一个很明显的格式。为了真正地访问一个指定项目符号的正确的值，代码需要以它自己的计算机语言把记录的值正确地翻译过来，这种语言对一般的VBA程序员来说可能不太常用，这个正确的字符代码能通过对记录的数字和4095 这个值做一个And操作来获取。

宏记录器为一个项目符号记录下正确的一个5位数字的值，例如.Caracter = 61646，但是， 为了返回待执行的代码，一个含有add操作的附加语句需要被人工加到VBE中。

下面这段代码为一个主页记录正确项目符号点的设置， 并以Wingdings字样把所有的项目符号改变为一个单独的字符。

Sub Format_Bullet()

    ActiveWindow.ViewType = ppViewSlideMaster

    ActivePresentation.SlideMaster.Shapes(1).Select

    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select

    With ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Paragraphs(Start:=1, Length:=1).ParagraphFormat.Bullet

        .Visible = msoTrue

        .UseTextColor = msoTrue

        .Font.Name = "Wingdings"

       

        .Character = 61646 And 4095

        ActiveWindow.ViewType = ppViewSlide

        End With

End Sub

11.   宏命令允许被用为定制的工具条按钮进行激活

步骤为：

先建立一个宏

回到Presentation上自定义工具栏，在自定义快速访问工具栏处选择命令：选择宏，并从列表中选择想要运行的宏命令，然后添加并确定。这时回到了Presentation状态，从顶部菜单上，我们就可以看到自定义的工具栏上的工具项。点击它，则会运行对应的宏命令，如同菜单项。

12.   使用组合框

Sub ComboBox()

    Dim MyArray(6, 2)

   

    UserForm1.ComboBox1.ColumnCount = 2

   

   

    MyArray(0, 0) = "Steve"

    MyArray(1, 0) = "Bill"

    MyArray(2, 0) = "Iveson"

    MyArray(3, 0) = "Joden"

    MyArray(4, 0) = "John"

    MyArray(5, 0) = "Tony"

    

    MyArray(0, 1) = "Charli"

    MyArray(1, 1) = "Beijing"

    MyArray(2, 1) = "Japan"

    MyArray(3, 1) = "New York"

    MyArray(4, 1) = "Toromne"

    MyArray(5, 1) = "Mactor"

    ‘写入其中的值到List中。

    UserForm1.ComboBox1.List() = MyArray

End Sub

 

‘准备显示这个UserForm.

Sub Pres()

    UserForm1.Show

End Sub

13.   使用渐变色

Sub Gradation()

    With ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRectangle, 0, 0, 400, 80).Fill

        .ForeColor.RGB = RGB(128, 10, 10)

        .BackColor.RGB = RGB(20, 170, 230)

        .TwoColorGradient msoGradientVertical, 1

    End With

End Sub

14.   添加一个Shape并设置其中的文字， 设置一个Shape中的格式

Sub Word()

    '添加了一个Shape,并设置其中的Text文本

    ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRectangle, 140, 140, 250, 140).TextFrame.TextRange.Text = "I'm a chinese people"

   

    '设置这个Shapez中的Text格式

    With Application.ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange

        .Paragraphs(1).Words(2, 5).Font.Bold = msoTrue

        .Paragraphs(1).Words().Font.Color.RGB = RGB(255, 255, 0)

    End With

End Sub

15.   添加一个Shape，并设置其3D效果

Sub ThreeDFormat()

    With ActivePresentation.Slides(1).Shapes.AddShape(msoShapeOval, 140, 140, 140, 140)

        With .ThreeD

            .Visible = msoTrue

            .Depth = 75

            .ExtrusionColor.RGB = RGB(255, 255, 0)

        End With

    End With

End Sub