用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

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 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 Sub

用VBA去操作PowerPoint

相关推荐