如何将图片添加到Powerpoint演示文稿图片占位符?
-
21-12-2019 - |
题
我在 Excel VBA 中创建了一些代码,为 Excel 的每一行创建 PowerPoint 演示文稿 1 幻灯片,并填充到 PowerPoint 中的特定文本框中。
我现在想添加所有与描述匹配的图像。这些都是 Jpeg,而不是图表等。
我该如何做到这一点?在 excel 中执行此操作更好,还是本身执行此 Powerpoint VBA 更好?
不管怎样,有人能帮我写一些关于如何做到这一点的代码吗?
图像框架已存在于 PowerPoint 中。每张幻灯片有 2 张图像(没有过渡或其他任何内容)。
谢谢你!
P.S 我在 Windows 7 上使用 PowerPoint 和 Excel 2010。
有没有办法从 Excel 中做到这一点?我的其余代码位于 Excel 中,如果能将其作为宏的一部分来实现那就太好了。
基本上我有一个我想使用的文件位置,例如C:\insertfoldername\imagename.jpeg 显示在电子表格的 H 列中(大约 400 行)。
我正在使用的 Powerpoint 模板具有图像框架(Powerpoint 中的图像框架,当您将鼠标悬停在它上面时会显示......“从文件插入图片”。
它们的尺寸已经确定并且位于正确的位置。
我想要做的是,在 Excel 中,从 Excel 中的文件路径粘贴图像并将其粘贴到特定的图像框架中。
这有可能吗?
基本上可以做到这一点:
PPT.ActivePresentation.Slides(2).Shapes(3)LoadImage(spath)
下面是我正在使用的代码。
**** 表示文件路径。jpg 文件被设置为 Excel 电子表格中的第三列。
Sub CreateSlides()
'Dim the Excel objects
Dim objWorkbook As New Excel.Workbook
Dim objWorksheet As Excel.Worksheet
'Dim the File Path String
Dim strFilePath As String
'Dim the PowerPoint objects
Dim PPT As Object
Dim pptSlide As PowerPoint.Slide
Dim pptLayout As PowerPoint.CustomLayout
Dim pptNewSlide As PowerPoint.Slide
Dim str As String
Dim Title As String
Set PPT = GetObject(, "PowerPoint.Application")
PPT.Visible = True
'Get the layout of the first slide and set a CustomLayout object
Set pptLayout = PPT.ActivePresentation.Slides(1).CustomLayout
'Run the OpenFile function to get an Open File dialog box. It returns a String containing the file and path.
strFilePath = OpenFile()
'Open the Excel file
Set objWorkbook = Excel.Application.Workbooks.Open(strFilePath)
'Grab the first Worksheet in the Workbook
Set objWorksheet = objWorkbook.Worksheets(1)
'Loop through each used row in Column A
For i = 2 To objWorksheet.Range("A65536").End(xlUp).Row
Set PPT = GetObject(, "PowerPoint.Application")
Set pptNewSlide = PPT.ActivePresentation.Slides.AddSlide(PPT.ActivePresentation.Slides.Count + 1, pptLayout)
'Get the number of columns in use on the current row
Dim LastCol As Long
Dim boldWords As String
boldWords = "Line1: ,line2: ,Line3: ,Line4: "
LastCol = objWorksheet.Rows(i).End(xlToRight).Column
If LastCol = 16384 Then LastCol = 1 'For some reason if only column 1 has data it returns 16384, so correct it
'Build a string of all the columns on the row
str = ""
str = "Line1: " & str & objWorksheet.Cells(i, 1).Value & Chr(13) & _
"Line2: " & objWorksheet.Cells(i, 2).Value & Chr(13) & _
"Line3: " & objWorksheet.Cells(i, 10).Value & Chr(13) & _
"Line4: " & objWorksheet.Cells(i, 7).Value & Chr(13) & Chr(13) & _
objWorksheet.Cells(i, 14).Value
sfile = Cells(i, 3) & ".jpg" **** This is the jpg name
Set PPT = GetObject(, "PowerPoint.Application")
spath = "C:\test\"
'Write the string to the slide
pptNewSlide.Shapes(2).TextFrame.TextRange.Text = objWorksheet.Cells(i, 3).Value 'This enters the film Title
PPT.ActivePresentation.Slides(PPT.ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = str
BoldSomeWords PPT.ActivePresentation.Slides(PPT.ActivePresentation.Slides.Count).Shapes(1), str, boldWords
'This is where I want to load in the Image.
'PPT.ActivePresentation.Slides(PPT.ActivePresentation.Slides.Count).Shapes(3).Picture = LoadPicture(spath) ' & sfile)
'PPT.ActivePresentation.Slides(2).Shapes(3)LoadImage((spath))
Next
End Sub
Function OpenFile()
'Dim the File Dialog object and string
Dim objFileDialog As FileDialog
Dim strFile As String
'Set the objFileDialog to an instance of the FileDialog object
Set objFileDialog = Application.FileDialog(msoFileDialogFilePicker)
'Set the Properties of the objFileDialog object
objFileDialog.AllowMultiSelect = False
objFileDialog.ButtonName = "Select"
objFileDialog.InitialView = msoFileDialogViewDetails
objFileDialog.Title = "Select Excel File"
objFileDialog.InitialFileName = "C:\"
objFileDialog.Filters.Clear
objFileDialog.Filters.Add "Excel", "*.xls; *.xlsx", 1
objFileDialog.FilterIndex = 1
'Show the FileDialog box
objFileDialog.Show
'Set strFile to the first record of the SelectedItems property of our FileDialog
strFile = objFileDialog.SelectedItems(1)
'Return the File Path string
OpenFile = strFile
End Function
解决方案
这是在当前打开的 PPT 中添加图片的方法 Picture PlaceHolders
使用 Excel。
我们用了 Early Binding
添加 Microsoft PowerPoint 14.0 Object Library
参考。
编辑1: 添加 DoEvents 和一些解释
Sub ImportPictureInPlaceHolderFromExcel()
Dim oPPt As PowerPoint.Application
Dim oPPtSlide As PowerPoint.Slide
Dim oPPtShp As PowerPoint.Shape
'~~> Get hold of PPt instance meaning your currently open PPT presentation
Set oPPt = GetObject(, "Powerpoint.Application")
'~~> Reference the first slide which should contain picture placeholders
Set oPPtSlide = oPPt.ActivePresentation.Slides(1)
'~~> Now check each shape in slide
For Each oPPtShp In oPPtSlide.Shapes
'~~> You only need to work on Picture place holders
If oPPtShp.PlaceholderFormat.Type = ppPlaceholderPicture Then
With oPPtShp
'~~> Now add the Picture
'~~> For this example, picture path is in Cell A1
oPPtSlide.Shapes.AddPicture Range("A1").Value, msoFalse, msoTrue, _
.Left, .Top, .Width, .Height
'~~> Insert DoEvents here specially for big files, or network files
'~~> DoEvents halts macro momentarily until the
'~~> system finishes what it's doing which is loading the picture file
DoEvents
End With
End If
Next
Set oPPtSlide = Nothing
Set oPPt = Nothing
End Sub
总结:
1.我们获取PPT申请
2.我们掌握幻灯片和幻灯片内的形状
3.现在我们选择的形状是 ppPlaceholderPicture
仅键入
4.我们使用 Shape Object's
(ppPlaceholder图片类型) .Top, .Left, .Width and .Height
属性作为参数 形状集合 .AddPicture
方法。
就这样,您已经在 PPT 图片占位符中添加了一张图片。
希望这是您所需要的。
其他提示
虽然这个看起来像它有效,当您将图像添加到带有空白图片或内容占位符的幻灯片时,它将始终进入该占位符并调整大小以适合。
您只需要添加它:
osld.Shapes.AddPicture "Path", msoFalse, msoTrue, -1, -1
.