Question

我遇到一个宏的问题，它将excel和powerpoint中的命名范围和图表复制。宏在我的计算机上按预期运行，但是当我在同事的计算机上运行宏时，我得到运行时错误＆＃39; -2147023170（800706be）＆＃39;。有问题的循环如下。

'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已关闭。当我尝试在另一台计算机上单步执行程序以找到有问题的行时，它会逐步执行几行，然后像正常一样运行直到它出错。但是，如果在循环内部某处抛出换行符并手动迭代它或在循环中放置一个消息框，代码将运行正常。

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

Answer 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也不起作用。这似乎有所帮助。

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

1 个答案: