2013-10-04 3 views
3

У меня есть этот код для копирования диаграмм из листа Excel 2010 в powerpoint. Он просматривает все диаграммы на активном листе, затем копирует и вставляет ссылку в PowerPoint. Существует также небольшой фрагмент кода, который берет название диаграммы и помещает его в качестве заголовка в PowerPoint.pastespecial объектов не удалось vba

В большинстве случаев он отлично работает для меня, однако он дает мне ошибку во время выполнения. -2147467259 (80004005) Метод «PasteSpecial» объекта «Shapes» не удался после того, как 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 
+1

После того, как вы вставьте, попробуйте 'Application.CutCopyMode = False', чтобы очистить буфер обмена? –

ответ

3

Причина очень проста. Вы не даете Excel достаточно времени, чтобы скопировать диаграмму в буфер обмена.

Попробуйте

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

Это решило. Замедляет процесс значительно, но все же намного эффективнее, чем я делаю это вручную. – mittence

+1

Это замедлит процесс, так как Excel требует времени для копирования вещей в буфер обмена в зависимости от размера того, что вы копируете :) –

0

Вы можете попробовать это так, он работал для меня, если не увеличить секунд и посмотреть (не это 1 сек, для меня он работал в течение 2 секунд.) Спасибо, Сайед.

ActiveChart.ChartArea.Copy 
Application.Wait Now + TimeValue("00:00:01") 
activeSlide.Shapes.PasteSpecial(Link:=True).Select 
Смежные вопросы