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

时间:2018-08-06 08:12:47

标签: vba excel-vba powerpoint powerpoint-vba

由于这个问题,我正在慢慢变得疯狂。我正在从excel工作簿中创建一个PowerPoint演示文稿,需要在其中填充数据。我已经在创建多个没有问题的幻灯片,并且已经解决了大多数问题。

我要做的最后一件事是从excel复制图表并将其粘贴到我的ppt中。这以前曾经奏效,但突然间就中断了,它不再想要粘贴图表了。

在我的主模块中,我将子ROI称为“ 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粘贴到幻灯片中,而当它循环到第二/第三/等...图表时,它不再希望粘贴。

这确实是非常随机的,我只看到其中的一些结构没有执行...

1 个答案:

答案 0 :(得分:0)

这是解决方案,在复制和粘贴之间使用“ DoEvents”。 如果我将图表制作成图片而没有问题,则只有在Excel中制作的图表才会出现此问题。但是从Excel复制/粘贴图表显然需要更多的处理时间,并且比程序运行速度慢。因此会不时跳过。

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

从以下位置得到答案:

Error in script which copies charts from Excel to PowerPoint