对象形状的特殊粘贴失败vba答案

【问题标题】：pastespecial of object shapes failed vba对象形状的特殊粘贴失败vba
【发布时间】：2020-05-01 16:55:06
【问题描述】：

我有这段代码可以将 Excel 2010 工作表中的图表复制到 PowerPoint 中。它循环搜索活动工作表上的所有图表，然后将链接复制并粘贴到 powerpoint 中。还有一小段代码可以获取图表标题并将其作为标题放入 PowerPoint 中。

它在大多数情况下都非常适合我，但是它给了我一个运行时错误 -2147467259 (80004005) 对象“形状”的方法“PasteSpecial”在将 9 个图表移入 PowerPoint 后失败。在完美运行中可能导致此故障的原因是什么？

Sub CreatePowerPoint()

 'Add a reference to the Microsoft PowerPoint Library by:

    Dim newPowerPoint As PowerPoint.Application
    Dim activeSlide As PowerPoint.Slide
    Dim cht As Excel.ChartObject

 'Look for existing instance
    On Error Resume Next
    Set newPowerPoint = GetObject(, "PowerPoint.Application")
    On Error GoTo 0

'Let's create a new PowerPoint
    If newPowerPoint Is Nothing Then
        Set newPowerPoint = New PowerPoint.Application
    End If
'Make a presentation in PowerPoint
    If newPowerPoint.Presentations.Count = 0 Then
        newPowerPoint.Presentations.Add
    End If

'Show the PowerPoint
    newPowerPoint.Visible = True

'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
    For Each cht In ActiveSheet.ChartObjects

    'Add a new slide where we will paste the chart
        newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
        newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
        Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)

    'Copy the chart and paste it into the PowerPoint
        cht.Select
        ActiveChart.ChartArea.Copy
        activeSlide.Shapes.PasteSpecial(Link:=True).Select

    'Set the title of the slide the same as the title of the chart
        If ActiveChart.HasTitle = True Then
            activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
        Else
            activeSlide.Shapes(1).TextFrame.TextRange.Text = "Add Title"
        End If
    'Adjust the positioning of the Chart on Powerpoint Slide
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 0.5 * 72
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 1.75 * 72
        newPowerPoint.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Height = 5.5 * 72
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Width = 8.92 * 72

       Next

AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set newPowerPoint = Nothing

End Sub

【问题讨论】：

粘贴后，试试Application.CutCopyMode = False清除剪贴板吧？

标签： vba excel

【解决方案1】：

原因很简单。您没有给 Excel 足够的时间将图表复制到剪贴板。

试试这个

    ActiveChart.ChartArea.Copy
    DoEvents
    activeSlide.Shapes.PasteSpecial(Link:=True).Select

【讨论】：

这解决了它。大大减慢了这个过程，但仍然比我手工做的效率高得多
它会减慢进程，因为 excel 需要时间根据您要复制的内容的大小将内容复制到剪贴板:)

【解决方案2】：

你也可以试试这个，它对我有用，如果不增加秒数然后看看（不是 1 秒，对我来说它工作了 2 秒。）谢谢，Syed。

ActiveChart.ChartArea.Copy
Application.Wait Now + TimeValue("00:00:01")
activeSlide.Shapes.PasteSpecial(Link:=True).Select

【讨论】：

【解决方案3】：

太棒了！没有 Stackoverflow 我该怎么办？

With Sheets("Step 2- GEs Eliminated") '粘贴到 Step2 表中 .Cells(2, i * 4).Select Application.Wait Now + TimeValue("00:00:001") '来自 Stackoverflow 的这一行。 ActiveSheet.Paste 结束于

【讨论】：