Question

我在Excel VBA中创建了一些代码，为每行Excel创建一个PowerPoint演示文稿1幻灯片，并填充在PowerPoint中的特定文本框中。
我现在想要添加与描述匹配的所有图像。这些都是Jpegs而不是图表等我怎么能这样做，在excel中做这个更好，还是更好的做这个Powerpoint VBA本身？
无论如何，任何人都可以帮我解决一些关于如何做到这一点的代码吗？图像框架已存在于PowerPoint中。每张幻灯片有2张图片（没有过渡或任何东西）谢谢！

P.S我在Windows 7上使用PowerPoint和Excel 2010。

有没有办法从Excel执行此操作？我的其余代码在Excel中，作为宏的一部分，这样做会很棒基本上我有一个我想要使用的文件位置，例如C：\ insertfoldername \ imagename.jpeg出现在电子表格的H列中（约400行）我正在使用的Powepoint模板具有图像框架（Powerpoint中的一个，你将它悬停在它上面说“从文件中插入图片”。）这些已经调整好并且位于正确的位置我想要做的是，在Excel中，粘贴excel中文件路径中的图像并将其过去到特定的图像框架中。
这有可能吗？

基本上可以做到这一点：
PPT.ActivePresentation.Slides(2).Shapes(3)LoadImage(spath)

以下是我正在使用的代码 ****表示文件路径。 jpg文件被设置为excel电子表格中的第3列。

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

Answer 1

这是使用Excel在当前打开的PPT Picture PlaceHolders中添加图片的方法我们使用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申请书我们抓住幻灯片和幻灯片内的形状 3.现在我们选择仅ppPlaceholderPicture类型的形状 4.我们使用Shape Object's（ppPlaceholderPicture类型）.Top, .Left, .Width and .Height属性作为 Shapes Collection的 .AddPicture方法的参数。

你去了，你在你的PPT图片占位符中添加了一张图片希望这就是你所需要的。

Answer 2

虽然看起来像，但是当您将图片添加到带有空白图片或内容占位符的幻灯片时，它会一直运行到该占位符并调整大小以适应。

您只需要像这样添加：

osld.Shapes.AddPicture "Path", msoFalse, msoTrue, -1, -1

如何将图片添加到Powerpoint Presentation Picture PlaceHolder？

2 个答案: