首页 > 解决方案 > 偶尔会遇到运行时错误 1004

问题描述

我创建了一个宏来将当前 Excel 工作簿中的单元格复制到 PowerPoint 演示文稿中。宏有效,但偶尔我会得到一个

运行时错误 1004:Range 类的 CopyPicture 方法失败。

在线的:

ActiveWorkbook.Sheets(i).Range("A1:O" & lastRow).CopyPicture Format:=xlPicture

我也会偶尔得到

运行时错误 -2147188160 (80048240):Shapes(未知成员):无效请求。剪贴板为空或包含可能无法粘贴到此处的数据。

在线的:

aSlide.Shapes.Paste.Select

奇怪的是错误发生在不同的地方。例如,有时在第 5 张幻灯片上会出现错误,然后如果我再次运行它,它会很好地处理第 5 张幻灯片,但在第 10 张幻灯片上再次遇到错误。

我尝试使用错误处理,但我尝试的一切最终都冻结了程序。

Sub CreateSlides()

    Dim PPApp As PowerPoint.Application
    Dim PPFile As PowerPoint.Presentation
    Dim lastRow As Integer
    Dim aSlide As Slide
    Dim path As String

    path = "C:Users\Me\Documents\WorksheetSlides.pptx"

    Set PPApp = CreateObject("PowerPoint.Application")
    Set PPFile = PPApp.Presentations.Open(path)

    For Each aSlide In PPFile.Slides
        i = aSlide.SlideNumber + 1

        aSlide.Select

        If i > ActiveWorkbook.Sheets.Count Then Exit For

        lastRow = ActiveWorkbook.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row

        ActiveWorkbook.Sheets(i).Range("A1:O" & lastRow).CopyPicture Format:=xlPicture
        aSlide.Shapes.Paste.Select
    Next

End Sub

标签: excelvbapowerpoint

解决方案


从 Excel 粘贴到 PowerPoint 时,这是一个臭名昭著的问题 - 解决方案是通过在复制/粘贴之间添加一个短暂的休息时间来给剪贴板一些喘息的时间。这是一个我们等待 2 秒(应该足够长)的示例:

Sub CreateSlides()

    Dim PPApp As PowerPoint.Application
    Dim PPFile As PowerPoint.Presentation
    Dim lastRow As Integer
    Dim aSlide As Slide
    Dim path As String

    path = "C:Users\Me\Documents\WorksheetSlides.pptx"

    Set PPApp = CreateObject("PowerPoint.Application")
    Set PPFile = PPApp.Presentations.Open(path)

    For Each aSlide In PPFile.Slides
        i = aSlide.SlideNumber + 1

        aSlide.Select

        If i > ActiveWorkbook.Sheets.Count Then Exit For

        lastRow = ActiveWorkbook.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row

        ActiveWorkbook.Sheets(i).Range("A1:O" & lastRow).CopyPicture Format:=xlPicture

        Wait

        aSlide.Shapes.Paste.Select
    Next

End Sub
Sub Wait()

    Application.Wait Now + TimeValue("0:00:02")

End Sub

推荐阅读