pastespecial對象形狀失敗vba

我有這段代碼將Excel 2010工作表中的圖表複製到Powerpoint中。它循環搜索活動工作表上的所有圖表，然後將鏈接複製並粘貼到PowerPoint中。還有一小段代碼將圖表標題作爲標題放入PowerPoint中。pastespecial對象形狀失敗vba

它在大多數情況下對我很好，但它給我一個運行時錯誤-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

來源

2013-10-04 mittence

粘貼後，試試'Application.CutCopyMode = False'來清除剪貼板可能？ –

原因很簡單。您沒有給Excel足夠的時間將圖表複製到剪貼板。

試試這個

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

來源

2013-10-04 16:44:25

這解決了它。顯着減慢過程，但仍然比我手動操作效率更高 – mittence

由於excel需要時間將事物複製到剪貼板，具體取決於您正在複製的內容大小，因此它會減慢過程速度:) –

你可以試試這個爲好，它的工作對我來說，如果不增加秒，看到（它是不是1秒，對於我來說，工作了2秒。）謝謝，賽義德。

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

來源

2014-08-07 17:05:46 Syed

pastespecial對象形狀失敗vba

回答

相關問題