Excel 到 PowerPoint 复制/粘贴宏不一致失败答案

【问题标题】：Excel to PowerPoint Copy/Paste Macro Inconsistently FailsExcel 到 PowerPoint 复制/粘贴宏不一致失败
【发布时间】：2017-10-24 21:20:25
【问题描述】：

我遇到了将命名范围和图表从 excel 复制到 PowerPoint 的宏的问题。宏在我的计算机上按预期运行，但是当我在同事的计算机上运行宏时，出现运行时错误“-2147023170 (800706be)”。有问题的循环如下。

'Create an Instance of PowerPoint
On Error Resume Next
    'Is PowerPoint already opened?
    Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    'Clear the error between errors
    Err.Clear
    'If PowerPoint is not already open then open PowerPoint
    If PowerPointApp Is Nothing Then
        Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
    End If
    '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

'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add
'Change aspect ratio
myPresentation.PageSetup.SlideSize = 2 
cycle=1

For Each ch In ThisWorkbook.Sheets("Meeting Metrics").ChartObjects
    'Add a slide to the Presentation
    Set mySlide = myPresentation.Slides.Add(cycle, 11) '11 = ppLayoutTitleOnly
    mySlide.Select
    With mySlide.Shapes.Title.TextFrame.TextRange
        .Text = slideTitles(cycle - 1)
        With .Font
            .Name = "Arial"
            .Size = 32
            .Color.RGB = RGB(237, 125, 49)
        End With
    End With

    'Check if there is a table (Excel cell range) to copy for this slide
    If Not IsMissing(copyRange(cycle - 1)) Then
        'Copy Excel Range
        ThisWorkbook.Sheets("Meeting Metrics").Range(copyRange(cycle - 1)).Copy
        'Paste to PowerPoint
        mySlide.Select
        mySlide.Shapes.Paste
        Set myShape = mySlide.Shapes(mySlide.Shapes.count)
        Application.CutCopyMode = False
        'Set position
        myShape.Top = tableVertPos(cycle - 1) * 72
        myShape.Left = tableHorPos(cycle - 1) * 72
    End If

    'Copy excel chart
    ch.Select
    ch.Chart.ChartArea.Copy
    'Paste to PowerPoint
    mySlide.Select
    mySlide.Shapes.Paste
    Set myShape = mySlide.Shapes(mySlide.Shapes.count)
    Application.CutCopyMode = False
    'Set position

    myShape.Top = chartVertPos(cycle - 1) * 72
    myShape.Left = chartHorPos(cycle - 1) * 72

    cycle = cycle + 1
Next

当错误发生时，powerpoint 将变得无响应并要求关闭。将弹出错误消息，调试会将我带到包含 mySlide 的行之一（并不总是同一行）。如果我尝试点击继续按钮，则会导致运行时错误 462，因为 powerpoint 已关闭。当我尝试单步执行另一台计算机上的程序以查找有问题的行时，它将单步执行几行，然后像正常一样运行，直到它出错。但是，如果在循环内的某处抛出换行符并手动迭代它或在循环内放置一个消息框，代码将运行良好。

我尝试在循环中插入等待或睡眠以查看是否有帮助，但这只会导致代码在失败前暂停几秒钟。

【问题讨论】：

不确定您的问题是什么（很可能是不同版本的 office 或更新），但您可以尝试 .Slides.AddSlide 方法。
感谢您的建议。不过我很好奇，使用其中一个有什么好处？
我不太确定，但是：Slides.addslides：创建一张新幻灯片，将其添加到 Slides 集合中，然后返回该幻灯片。 Slides.add：创建一张新幻灯片并将其添加到集合中。也许 add 方法没有返回幻灯片？

标签： vba excel powerpoint

【解决方案1】：

系统中似乎存在一个错误，在某些地方被描述为“超前”。我通过以下丑陋的解决方法取得了一些成功...

创建以下 UglyWait 子过程

Sub UglyWait(Optional sec As Integer = 1)
    Dim future As Date
    future = DateAdd("s", sec, Now())
    Do While Now() < future
        DoEvents
    Loop
End Sub

在任何 Powerpoint 转到、粘贴或保存操作之前和之后调用 UglyWait。

Application.Wait 不起作用，标准的单个 DoEvents 也不起作用。不过这似乎确实有帮助。

【讨论】：