0

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

  1. 带有公式和宏的 Excel 模板可创建包含大约 30 个图表的自定义报告
  2. 名为“CreatePowerPointPresentation”的宏用于将这些图表以特定格式转换为特定的 PowerPoint 模板
  3. 宏使用模板中包含的幻灯片来创建前 6 张幻灯片
  4. 然后宏添加幻灯片（过渡和内容幻灯片）

注意：这个宏实际上是根据这个论坛的反馈创建的

此宏在带有 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
4

1 回答 1

0

这听起来像是我在 PowerPoint 中遇到的可怕的代码失控场景，在这种情况下，将内容复制到 Windows 剪贴板并从 Windows 剪贴板粘贴内容比执行 VBA 代码需要更多时间，因此 VBA 代码会提前运行并因此失败。要确认这是原因，请在 .Copy、.ViewType 和 .PasteSpecial 行上放置一些断点，看看它是否仍然无法用于您的完整幻灯片集合。如果没有，请尝试在 .Copy 和 .ViewType 行之后添加一些 DoEvents 行，如果这没有帮助，请注入一到两秒的延迟而不是 DoEvents。这至少可以确认假设是否正确。

于 2016-02-22T09:30:13.467 回答