对象形状的特殊异常vba [英] pastespecial of object shapes failed vba

问题描述

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

在大多数情况下，它对我来说非常适用，但是它给我一个运行时错误-2147467259（80004005）对象形状的方法PasteSpecial在9个图表之后失败已被移动到powerpoint。什么可能导致这个失败在完美的运行？

  Sub CreatePowerPoint（）
 
'添加对Microsoft PowerPoint库的引用：
 
 Dim newPowerPoint As PowerPoint.Application 
 Dim activeSlide As PowerPoint.Slide 
 Dim cht As Excel.ChartObject 
 
'查找现有的实例
在错误恢复Next 
设置newPowerPoint = GetObject（，PowerPoint.Application）
错误GoTo 0 
 
'让我们创建一个新的PowerPoint 
如果newPowerPoint没有，然后
设置newPowerPoint =新的PowerPoint.Application 
结束如果
'在PowerPoint演示文稿
如果newPowerPoint.Presentations.Count = 0然后
 newPowerPoint.Presentations.Add 
如果
 
'显示PowerPoint 
 newPowerPoint.Visible = True 
 
'循环遍历每个在Excel工作表中的图表并将其粘贴到PowerPoint 
 For每个cht在ActiveSheet.ChartObjects 
 
'添加一个新的幻灯片，我们将粘贴图表
 newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1，ppLayoutText 
 newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count 
设置activeSlide = newPowerPoint.ActivePresentation.Slides（newPowerPoint.ActivePresentation.Slides.Count）
 
'复制图表和粘贴它进入PowerPoint 
 cht.Select 
 ActiveChart.ChartArea.Copy 
 activeSlide.Shapes.PasteSpecial（Link：= True）。选择
 
'设置标题幻灯片与图表的标题相同
如果ActiveChart.HasTitle = True然后
 activeSlide.Shapes（1）.TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text 
其他
 activeSlide.Shapes（1）.TextFrame.TextRange.Text =添加标题
 End If 
'调整posi Powerpoint幻灯片上的图表
 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 
 
下一个
 
 AppActivate（Microsoft PowerPoint）
设置activeSlide = Nothing 
设置newPowerPoint = Nothing 
 
 End Sub 
  

解决方案

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

尝试这个

  ActiveChart.ChartArea.Copy 
 DoEvents 
 activeSlide.Shapes.PasteSpecial（Link：= True）。选择
  

I have this code to copy charts from an Excel 2010 worksheet into powerpoint. It loops through searches for all charts on the active worksheet then copy and pastes a link into powerpoint. There is also a small snippet of code that takes the chart title and puts it as a title into PowerPoint.

It works perfectly for me in most instances, however it is giving me a runtime error -2147467259 (80004005) Method 'PasteSpecial' of object 'Shapes' failed after 9 charts have been moved into powerpoint. What could be causing this failure in the middle of running perfectly?

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

解决方案

The reason is very simple. You are not giving the Excel enough time to copy the chart to the clipboard.

Try this

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

这篇关于对象形状的特殊异常vba的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！