对象形状的特殊粘贴失败 vba
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19186146/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
pastespecial of object shapes failed vba
提问by mittence
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.
我有这段代码可以将 Excel 2010 工作表中的图表复制到 powerpoint 中。它循环搜索活动工作表上的所有图表，然后将链接复制并粘贴到 powerpoint 中。还有一小段代码可以获取图表标题并将其作为标题放入 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?
在大多数情况下，它对我来说非常有效，但是它给了我一个运行时错误 -2147467259 (80004005) 对象“Shapes”的方法“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
采纳答案by Siddharth Rout
The reason is very simple. You are not giving the Excel enough time to copy the chart to the clipboard.
原因很简单。您没有给 Excel 足够的时间将图表复制到剪贴板。
Try this
尝试这个
ActiveChart.ChartArea.Copy
DoEvents
activeSlide.Shapes.PasteSpecial(Link:=True).Select
回答by Syed
You can try this as well, It worked for me, if not increase the seconds and see (not it is 1 sec, For me it worked for 2 secs.) Thanks, Syed.
你也可以试试这个，它对我有用，如果不增加秒数，看看（不是 1 秒，对我来说它工作了 2 秒。）谢谢，赛义德。
ActiveChart.ChartArea.Copy
Application.Wait Now + TimeValue("00:00:01")
activeSlide.Shapes.PasteSpecial(Link:=True).Select
回答by Gopinath Chandroth
Excellent! What would I do without Stackoverflow?
优秀！如果没有 Stackoverflow，我该怎么办？
With Sheets("Step 2- GEs Eliminated") 'paste into the Step2 sheet .Cells(2, i * 4).Select Application.Wait Now + TimeValue("00:00:001") 'this line from Stackoverflow. ActiveSheet.Paste End With
With Sheets("Step 2- GEs Eliminated") '粘贴到 Step2 sheet .Cells(2, i * 4).Select Application.Wait Now + TimeValue("00:00:001") '这行来自 Stackoverflow。ActiveSheet.Paste 结束于
