Question

我已经搜索了一个答案但是空了，所以我希望这是可以解决的。

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

我无法打开我想要的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

错误13 VBA，尝试将图像插入ppt /尝试使用已存在的ppt

1 个答案: