Question

寻找有关更新完成以下操作的VBA脚本的一些帮助（基本算法）：

包含公式和宏的Excel模板可创建包含大约30个图表的自定义报告
名为“CreatePowerPointPresentation”的宏用于将这些图表以特定格式传输到特定的PowerPoint模板
宏使用模板中包含的幻灯片创建前6张幻灯片
然后宏添加幻灯片（转场和内容幻灯片）

注意：此宏实际上是根据此论坛的反馈

此宏在带有Office 2013的Windows 7中运行良好，但在创建幻灯片8之后，在其中一个粘贴图表操作期间随机生成了Windows 10，Office 2016中的错误，但从未超过17张幻灯片的幻灯片10

错误：

Runtime Error '-2147188160 (80048240)
Method 'PasteSpecial'of object 'Shapes' failed.

或者

Runtime Error '-2147023170 (800706be)':
Automation Error 
The Remote procedure call failed.

我不确定这是一个对象问题还是我遗失的其他一些内容。

以下代码：

Sub CreatePowerPointPresentation()
'=========================================================================
'Create PowerPoint Presentation
'Assigned to Index Tab
'==========================================================================


        Dim newPowerPoint As PowerPoint.Application
        Dim activeSlide As PowerPoint.Slide
        Dim CHT As Excel.ChartObject
        Dim fmt As String
        Dim hgt As String
        Dim wth As String


‘this code allows for the user to select whether to paste the charts as Excel Charts or PNG Formatted images.

Sheets("Index").Select
            If Range("AB7").Value = "Excel Charts" Then
                fmt = ppPasteDefault
            Else
                fmt = ppPastePNG
            End If

   'Establishes the global height and width of the graphics or charts pasted from Excel
        hgt = 280
        wth = 710

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

    '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
            Application.EnableEvents = True
            Application.ScreenUpdating = True

           'Apply Template & Create Title Slide 1

             newPowerPoint.ActivePresentation.ApplyTemplate Application.DefaultFilePath & "\file.potx"

            'Set presentation to be 16x9
            'AppActivate ("Microsoft PowerPoint")
                With newPowerPoint.ActivePresentation.PageSetup
                .SlideSize = ppSlideSizeOnScreen16x9
                .FirstSlideNumber = 1
                .SlideOrientation = msoOrientationHorizontal
                .NotesOrientation = msoOrientationVertical
               End With
'Create Slides 2-6 these are imported from the template
newPowerPoint.ActivePresentation.Slides.InsertFromFile Application.DefaultFilePath & "\File.potx", 0, 1

'Create Slide 7

newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutBlank
newPowerPoint.ActivePresentation.Slides(7).CustomLayout = newPowerPoint.ActivePresentation.SlideMaster.CustomLayouts(33)
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)

With newPowerPoint.ActivePresentation.Slides(7)
                .Shapes("Title 1").TextFrame.TextRange.Text = "Title1"
End With
            newPowerPoint.ActiveWindow.ViewType = ppViewSlide

‘Create Slide 8 – Quad Chart Slide

newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutBlank
newPowerPoint.ActivePresentation.Slides(8).CustomLayout = newPowerPoint.ActivePresentation.SlideMaster.CustomLayouts(13)
newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
newPowerPoint.ActivePresentation.Slides(8).Shapes("Title 1").TextFrame.TextRange.Text = "Title 1"
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
newPowerPoint.ActiveWindow.ViewType = ppViewSlide

        'Upper Left
            Sheets("Charts").Select
            ActiveSheet.ChartObjects("Chart 3").Select
            ActiveChart.ChartArea.Copy
            newPowerPoint.ActiveWindow.ViewType = ppViewSlide
            activeSlide.Shapes.PasteSpecial(DataType:=fmt).Select

          'Adjust the positioning of the Chart on Powerpoint Slide
           newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 5
           newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 75
           newPowerPoint.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
           newPowerPoint.ActiveWindow.Selection.ShapeRange.Height = 145
           newPowerPoint.ActiveWindow.Selection.ShapeRange.Width = 345

        'Upper Right
            Sheets("Charts").Select
            ActiveSheet.ChartObjects("Chart 2").Select
            ActiveChart.ChartArea.Copy
            newPowerPoint.ActiveWindow.ViewType = ppViewSlide
            activeSlide.Shapes.PasteSpecial(DataType:=fmt).Select

           newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 350
           newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 75
           newPowerPoint.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
           newPowerPoint.ActiveWindow.Selection.ShapeRange.Height = 145
           newPowerPoint.ActiveWindow.Selection.ShapeRange.Width = 345


        'Lower Left
            Sheets("Charts").Select
            ActiveSheet.ChartObjects("Chart 4").Select
            ActiveChart.ChartArea.Copy
            newPowerPoint.ActiveWindow.ViewType = ppViewSlide
            activeSlide.Shapes.PasteSpecial(DataType:=fmt).Select

            newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 5
            newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 230
            newPowerPoint.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
            newPowerPoint.ActiveWindow.Selection.ShapeRange.Height = 145
            newPowerPoint.ActiveWindow.Selection.ShapeRange.Width = 690


‘More slides……

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Set activeSlide = Nothing
    Set newPowerPoint = Nothing

End Sub

Answer 1

这听起来像我在PowerPoint中面临的可怕的代码失控场景，之前需要花费更多时间来复制东西并从Windows剪贴板粘贴东西而不是VBA代码执行，因此VBA代码会提前运行并作为结果。要确认这是原因，请在.Copy，.ViewType和.PasteSpecial行上放置一些断点，看看它是否仍然无法完成幻灯片集合。如果没有，请尝试在.Copy和.ViewType行之后添加一些DoEvents行，如果这没有帮助，请注入一个或两秒的延迟而不是DoEvents。这至少会证实假设是否属实。

Excel VBA创建PowerPoint演示文稿

1 个答案: