VBA PPT复制/粘贴图表不一致

Posted 2023-02-25

【中文标题】VBA PPT复制/粘贴图表不一致

【英文标题】：VBA PPT copy/paste chart inconsistent

【发布时间】：2018-08-06 08:12:46

【问题描述】：

因为这个问题，我慢慢变得疯狂。我正在从一个需要填写数据的 Excel 工作簿创建一个 PowerPoint 演示文稿。我已经创建了多张幻灯片，没有任何问题，并且已经解决了大多数问题。

我要做的最后一件事是从 excel 中复制一个图表并将其粘贴到我的 ppt 中。以前可以，但是突然就坏了，不想再粘贴图表了。

在我的主模块中，我用一些必需的数据调用 sub ROI 以继续

Call ROI(PPPRes, Slidestart, language, i)

这是在一个单独的模块中，以保持主模块中的东西干净

Sub ROI(PPPRes, Slidenumber, language, proposal)
Set pp = CreateObject("PowerPoint.Application")
Dim oPPTShape As PowerPoint.Shape
Dim PPSlide As PowerPoint.Slide
Dim ColumnWidthArray As Variant
Dim i As Integer

'Create a slide on Slidenumber location
Set PPSlide = PPPRes.Slides.Add(Slidenumber, ppLayoutTitleOnly)
PPSlide.Select
PPSlide.Shapes("Title 1").TextFrame.TextRange.Text = Range("Titlename in chosen language")
PPSlide.Shapes.AddTable(3, 3).Select
Set oPPTShape = PPSlide.Shapes("Table 4")

'Filling in data in the table from an excel table. Basic stuff working with a few loops to make this happen


        'Changing the width of the created table, column by column
        ColumnWidthArray = Array(37, 210, 180)
        Set oPPTShape = PPSlide.Shapes("Table 4")
        On Error Resume Next
        With oPPTShape
            For i = 1 To 3
                .table.columns(i).width = ColumnWidthArray(i - 1)
            Next i
            .Top = 180
            .Left = 520
            .height = 200
        End With

        'Add a rectangle on the slide
        PPSlide.Shapes.AddShape Type:=msoShapeRectangle, Left:=404, Top:=400, width:=153, height:=43

        'Copy a picture from excel and paste it in the active slide   
        Sheets("Shapes").Shapes("ROI_img").Copy
        PPSlide.Shapes.Paste.Select
        pp.ActiveWindow.Selection.ShapeRange.Left = 800
        pp.ActiveWindow.Selection.ShapeRange.Top = 20

'Copy chart from excel (with index number that is linked to "proposal") and then paste onto slide
Sheets("Proposals").Shapes("ChartInvProp" & proposal).Copy
PPSlide.Shapes.Paste.Select
Set oPPTShape = PPSlide.Shapes("ChartInvProp" & proposal)
With PPSlide.Shapes("ChartInvProp" & proposal)
    .Left = 20
    .Top = 120
    .width = 480
    .height = 320
End With
end sub

因此，代码中的所有内容都已执行，但大多数时候 Excel 中的图表并未粘贴到幻灯片上。 但是，如果我在从 Excel 复制图表后通过中断代码检查剪贴板中的内容。然后我手动将剪贴板中的任何内容粘贴到 Word 文档中，我将看到图表。 --> 正在执行复制图表的动作，而不是粘贴部分 如果我现在在休息后继续，图表将以某种方式粘贴在 powerpoint 上。但是如果我不破坏代码，让它运行，图表将不会被粘贴。

不知何故，复制后似乎需要更多时间才能真正粘贴图表。我真的不明白这里发生了什么。 有时它只在幻灯片中粘贴图表 1，当它循环播放第二个/第三个/等...图表时，它不想再粘贴它了。

真的很随机​​，我只看到里面有一点结构没有执行……

【问题讨论】：

我知道你对粘贴图表的痛苦。我发现的解决方法是创建演示文稿模板并更新模板中已存在的图表背后的数据，而不是粘贴新图表。这对您有用吗？

为什么你有.Paste.Select 而不是.Paste？您还设置了On Error Resume Next 更进一步的代码 - 您是否尝试添加On Error GoTo 0 以便 VBA 会告诉您错误是什么？

@DarrenBartrup-Cook 如果我在幻灯片中创建表格之前先粘贴图表，它会起作用。所以现在它可以工作并且没有遇到没有在我的演示文稿中复制的图表（手指交叉）。

@Chronocidal 嗯，可能是习惯的力量。会改变它，但我猜它没有任何影响？还没试过On Error Goto 0，去看看。但是On Error Resume Next 仅对更改列的宽度有效，即确保数组中的#width 值与列的# 不匹配，但我想在这种情况下它可以被删除。

问题“回来了” - 它仍然不时跳过图表的副本。仍然没有接近找出发生这种情况的原因。

【参考方案1】：

这就是解决方案，在复制和粘贴之间使用“DoEvents”。 这个问题只发生在 Excel 中制作的图表中，如果我将图表制作成图片，它可以正常工作。但是从 Excel 复制/粘贴图表显然需要更多的处理时间并且比程序运行速度慢。所以它会时不时地跳过。

Sheets("Proposals").Shapes("ChartInvProp" & proposal).Copy
DoEvents
PPSlide.Shapes.Paste.Select

答案来自：

Error in script which copies charts from Excel to PowerPoint