Question

因此，我试图创建一个宏，该宏将从excel工作表（在本例中为“ Regions”工作表）中复制数据，然后复制粘贴到现有的PowerPoint模板中，幻灯片编号为4。

请注意，powerpoint和excel文件都保存在保管箱文件夹中。（如果那改变了什么）我不是VBA专家，所以无法理解为什么它会向我显示此错误。

代码如下：

Sub excelrangetopowerpoint()

Dim rng As Range
Dim powerpointapp As Object
Dim mypresentation As Object
Dim destinationPPT As String
Dim myshape As Object
Dim myslide As Object

Set rng = Worksheets("regions").Range("B1:N18")

On Error Resume Next

Set powerpointapp = CreateObject("powerpoint.application")
detinationppt = ("C:\Users\OLX-Admin\Dropbox (Corporate Finance)\Naspers Monthly Reporting\Prep for call\From teams\FY2019\OLX Group Monthly Report_Sep'18_Macro.pptx")
PowerPoint.Presentations.Open (destinationPPT)

On Error GoTo 0

Application.ScreenUpdating = False

Set mypresentation = PowerPoint.ActivePresentation
Set myslide = mypresentation.Slides(4)

rng.Copy

myslide.Shapes.PasteSpecial DataType:=2 '2 = enhanced metafile
Set myshape = myslide.Shapes(myslide.Shapes.Count)

myshape.Left = 152
myshape.Top = 152

powerpointapp.Visible = True
powerpointapp.Activate

Application.CutCopyMode = False

End Sub

Answer 1

您的代码中有两个未定义的变量

detinationppt而不是destinationppt
您将PowerPoint应用程序对象分配给powerpointapp，但是两行之后，您访问（未定义的）对象PowerPoint

您可以通过将Option Explicit放在代码的顶部来轻松避免此类错误。

接下来的事情是，您可以分配打开的演示文稿，而不必访问ActivePresentation。我进行了测试，对我来说访问ActivePresentation失败。

除非您确切知道自己在做什么，否则请不要在代码中加入On Error resume Next。如果要避免由于无法启动Powerpoint而导致运行时错误，则必须自己处理错误情况（这是由“运行良好的代码”完成的）。首先，只需将其删除。

这段代码对我有用（当然，文件名也不同）

Set powerpointApp = CreateObject("powerpoint.application")
destinationPPT = C:\Users\OLX-Admin\Dropbox (Corporate Finance)\Naspers Monthly Reporting\Prep for call\From teams\FY2019\OLX Group Monthly Report_Sep'18_Macro.pptx    
Set myPresentation = powerpointApp.Presentations.Open(destinationPPT)
Set mySlide = myPresentation.Slides(4)
(...)

Answer 2

首先，将此行添加到模块顶部，作为整个内容的第一行文本：

Option Explicit

然后，在菜单栏中单击“调试”和“编译VBA项目”

您将收到一系列错误消息，如下所示：

编译错误：

未定义变量

VBA将为您选择尚未定义的变量。其中大多数似乎是错别字，例如

detinationppt = ("C:而非destinationPPT = ("C:
PowerPoint.Presentations.Open (destinationPPT)而非PowerPointApp.Presentations.Open (destinationPPT)
Set mypresentation = PowerPoint.ActivePresentation而非Set mypresentation = PowerPointApp.ActivePresentation

基本上，您好像已经复制并粘贴了2个不同的代码块，却忘记检查变量名是否全部匹配（而且，似乎是Early Binding, and the other is Late Binding）

如果转到“工具”>“选项...”>“编辑器”，则有一个复选框，“需要变量声明”。启用此功能，使其保持打开状态，并定期使用“编译VBA项目”选项检查拼写错误和类似错误。

Answer 3

这是可以正常工作的代码：

Sub ExcelRangeToPowerPoint()

Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object

'Range to copy
Set rng = Worksheets("regions").Range("B1:N18")

On Error Resume Next

Set PowerPointApp = GetObject(class:="PowerPoint.Application")

Err.Clear

'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = 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

'To create new presentation
Set myPresentation = PowerPointApp.Presentations.Add
'to add new slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly

rng.Copy

'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

myShape.Left = 152
myShape.Top = 152

PowerPointApp.Visible = True
PowerPointApp.Activate

Application.CutCopyMode = False

End Sub

当我尝试运行以下宏时，Active X错误429无法创建对象

3 个答案: