vba 如何控制listbox的字号_用VBA控制ppt的一些要点-CSDN博客

因为工作中，需要将excel中的内容复制粘贴到ppt中，再贴入与之对应的图片，统一的ppt模板不停地复制粘贴，实在是浪费时间，于是我才寻找一些可以自动化的方法。

我常用到VBA的常规操作只在excel中，要用VBA控制ppt中的文本并贴入图片，着实让我思考了一段时间，但因此我也学习到不少，因有所得，记录在此作为学习输出并分享吧。

定义变量：

Public ppapp As PowerPoint.Application
Public pppres As PowerPoint.presentation
Public actfilename As Variant
Public totalslide As Object
Public Picpath As String

因为为了方便自己看和修改，后续的宏我分成了几个部分，变量的定义我就选择公共变量。

第一部分：

actfilename = Application.GetOpenFilename("microsoft powerpoint-file(*.pptx),*.pptx") 
Set ppapp = CreateObject("powerpoint.application") 
ppapp.Visible = True
ppapp.Activate
Set pppres = ppapp.Presentations.Open(actfilename)

GetOpenFilename：显示标准的“打开”对话框，并获取用户文件名，不打开任何文件。获取的文件名用open打开，个人认为这样的结合会很灵活，看起来也很厉害（┑(￣Д ￣)┍）

FileFilter 参数由文件筛选字符串对以及后跟的 MS-DOS 通配符文件筛选规范组成，还不是很懂这个参数是如何写的，只知其然不知其所以然，如果有人看到这篇文章并知道的话，不妨指教一下我。

第二部分：

ppapp.ActivePresentation.Slides(1).Layout = ppLayoutBlank
ppapp.ActivePresentation.Slides(1).Shapes.AddPicture Filename:="D:QQPCmgrDesktopexceltoppt背景.jpg", linktofile:=msoTrue, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=992, Height:=568

第一部分中打开的ppt文件就是我已经设计好的模板，

由于需要添加一张图片作为封面，所以将第一p（slide(1)）的板式（layout）先改成空白（ppLayoutBlank），再用到addpicture方法，设定图片的位置大小参数。我发现如果用我设计的板式添加图片的话，位置和大小参数将毫无用处...图片会直接插入到图片占位符中，故需要改一下板式为空白。

With ppapp.ActivePresentation.Slides(1).Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=0, Top:=450, Width:=992, Height:=100)
    .TextFrame.TextRange.Text = Range("G2").Value 
    .TextFrame.TextRange.Font.Size = 44
    .TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
    .TextFrame.VerticalAnchor = msoAnchorMiddle 
    .TextFrame.HorizontalAnchor = msoAnchorCenter 
    End With

在第一p插入封面图片后插入文本框（TextFrame），文本框的文本（TextRange）对象设置内容、字号、颜色、居中

第三部分：

ppapp.ActivePresentation.Slides.Add ppapp.ActivePresentation.Slides.Count + 1, ppLayoutCustom

开始添加设计好的模板，注意slides的add方法中index是新幻灯片在 Slides 集合中的索引号。ppLayoutCustom是设计好的板式，注意该板式要放在板式的第一个。这里我还不够清楚，ppLayoutCustom只能代表一个设计好的板式，且在板式的第一个，如果有多个的话，要如何表达还真的不甚清楚，又一次求指教了。

向模板中输入内容时，设计占位符的顺序很重要，他会简化你的代码。我的顺序如下：

row = 2
Set totalslide = ppapp.ActivePresentation.Slides(ppapp.ActivePresentation.Slides.Count)
totalslide.Shapes(1).TextFrame.TextRange.Text = Range("A" & row)
totalslide.Shapes(2).TextFrame.TextRange.Text = "社区地址：" & Range("D" & row) & vbLf & "合同规定：" & Range("B" & row) & vbLf & "实际发布：" & Range("C" & row)
totalslide.Shapes(5).TextFrame.TextRange.Text = Range("A" & row + 1)
totalslide.Shapes(6).TextFrame.TextRange.Text = "社区地址：" & Range("D" & row + 1) & vbLf & "合同规定：" & Range("B" & row + 1) & vbLf & "实际发布：" & Range("C" & row + 1)

这是按要求填充文本占位符的文本内容

Picpath = "D:QQPCmgrDesktopexceltoppt"
totalslide.Shapes.AddPicture Filename:=Picpath & "外景照片" & Range("A" & row) & ".jpg", linktofile:=msoTrue, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=0, Height:=0
totalslide.Shapes.AddPicture Filename:=Picpath & "外景照片" & Range("A" & row + 1) & ".jpg", linktofile:=msoTrue, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=0, Height:=0
totalslide.Shapes.AddPicture Filename:=Picpath & Range("G2") & "" & Range("A" & row) & "1.jpg", linktofile:=msoTrue, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=0, Height:=0
totalslide.Shapes.AddPicture Filename:=Picpath & Range("G2") & "" & Range("A" & row + 1) & "1.jpg", linktofile:=msoTrue, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=0, Height:=0

这是按照占位符的顺序添加对应的照片，之前说过有图片占位符的时候，addpicture的位置大小的参数都不重要了，所以这里的Left:=0, Top:=0, Width:=0, Height:=0，如果中间某一张照片缺失，后面的照片会填充到前一个占位符，这也是一个我未解决的问题。所以工作中我必须保证每一张照片都存在。

临表涕零，不知所言。