错误13 VBA，尝试插入图像到ppt /试图使用已有的ppt

Question

我已经搜索了一个答案，但空了，所以我张贴希望这是可以修复的。

我在Excel文件中有数字，图表和数组，我想将它们导出到给定的PowerPoint文件。

我无法打开我想要的简报，所以我必须创建一个新的。我无法将图像插入到新文件中。我收到错误13，不兼容。 （设置的oPic行抛出错误）

VBA脚本在Excel中。

这是我

Sub ExcelRangeToPPT() 
Dim PPT As Object 
Dim MyPres As Object 
Dim MySlide As Slide 
Dim myShape As Shape 
Dim oPic As Shape 

Dim icount As Integer 
Dim file As String 

file = "C:\Users\Amandine\Desktop\RapportsAuto\Client_Date.pptm" 

Set Rng = Worksheets("Setup").Range("Nom_PG") 

On Error Resume Next 
Set PPT = GetObject(file, class:="PowerPoint.Application") 
Err.Clear 
If PPT Is Nothing Then Set PPT = CreateObject(class:="PowerPoint.Application") 
    'Handle if the PowerPoint Application is not found 
     If Err.Number = 429 Then 
     MsgBox "PowerPoint could not be found, aborting." 
     Exit Sub 
     End If 
     On Error GoTo 0 
Application.ScreenUpdating = False 
Set MyPres = PPT.Presentations.Add 
Set MySlide = MyPres.Slides.Add(1, 11) 
Set oPic = MyPres.Slides(1).Shapes.AddPicture("C:\Users\Amandine\Desktop\RapportsAuto\ImagePG.png", False, True, 0, 0, 1, 1) 

预先感谢您

Answer 1

我修改您的代码并测试成功，它的工作原理如下：

Option Explicit 

' Runs in Excel VBE so a reference to the Microsoft PowerPoint XX Object Library is required for Early Binding 
' To use the more reliable Late Binding, change the PowerPoint.XYZ object types to "Object" and remove the reference above 
Sub ExcelRangeToPPT() 
    ' Late Binding PowerPoint objects 
    Dim oPPT As Object 
    ' Early Binding PowerPoint objects 
    Dim oPres As PowerPoint.Presentation ' Object 
    Dim oSld As PowerPoint.Slide ' Object 
    Dim oShp As PowerPoint.Shape ' Object 
    Dim oPic As PowerPoint.Shape ' Object 
    Dim oLayout As PowerPoint.CustomLayout ' Object 
    ' Excel objects 
    Dim oRng As Range 

    Dim iCount As Integer 
    Dim sFile As String 

    Const sPath = "C:\Users\Amandine\Desktop\RapportsAuto\" 

    sFile = sPath & "Client_Date.pptm" 

    Set oRng = Worksheets("Setup").Range("Nom_PG") 

    On Error Resume Next 
    Set oPPT = GetObject(sFile, "PowerPoint.Application") 
    Err.Clear 
    If oPPT Is Nothing Then Set oPPT = CreateObject("PowerPoint.Application") 
     'Handle if the PowerPoint Application is not found 
     If Err.Number = 429 Then 
      MsgBox "PowerPoint could not be found, aborting." 
      Exit Sub 
     End If 
     On Error GoTo 0 
    Application.ScreenUpdating = False 
    Set oPres = oPPT.Presentations.Add 
    Set oLayout = oPres.Designs(1).SlideMaster.CustomLayouts(11) 
    Set oSld = oPres.Slides.AddSlide(1, oLayout) 
    Set oPic = oPres.Slides(1).Shapes.AddPicture(sPath & "ImagePG.png", False, True, 0, 0, 1, 1) 

    ' Do other actions 

    ' Clear Up 
    Set oPres = Nothing 
    Set oLayout = Nothing 
    Set oSld = Nothing 
    Set oPic = Nothing 
    Set oShp = Nothing 
End Sub