VBA复制范围从Excel到PowerPoint

Question

我正在尝试从excel复制特定范围，并将其作为图片粘贴到pp中。 我从各种在线来源整理了以下代码，并在运行PowerPointApp.WindowState = 2时继续出现运行时91错误（未设置对象变量或With块变量）。

如何解决此错误，并在以后避免？

首先，我成功运行

    Private Sub OpenPowerpoint()

        Dim PPT As PowerPoint.Application
        Set PPT = New PowerPoint.Application

        PPT.Visible = True
        PPT.Presentations.Open Filename:="C:\Users\aofarrell\Desktop\CYB\Weekly Pack Update - Template.pptx"
        PPT.ActivePresentation.Slides(2).Select

    End Sub

然后我尝试跑步

 Private Sub CopyToPowerPoint()

            Dim rng As Range
            Dim PowerPointApp As Object
            Dim mySlide As Object
            Dim myShape As Object


        'Copy Range from Excel

            Set rng = ThisWorkbook.Sheets("Triggers").Range("B6:Z33")

        'Copy Excel Range
            rng.Copy

        'Paste to PowerPoint and position
            PowerPointApp.WindowState = 2 'ERROR OCCURS HERE
            mySlide.Shapes.PasteSpecial DataType:=0
            Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

        'Set position:
            myShape.Left = 20
            myShape.Top = 70
            myShape.Width = 675
            myShape.Height = 400

        'Clear The Clipboard
            Application.CutCopyMode = False
            Application.Wait (Now + TimeValue("00:00:01"))

        End Sub

Answer 1

嗯...首先，您需要定义PowerPointApp的Object类型。 以及mySlide是什么具体对象。 还请记住，局部变量在Sub / Function的末尾被销毁，因此您可能需要一些Module级别的变量/对象：

Option Explicit

Private PPT As PowerPoint.Application
Private PPT_pres As PowerPoint.Presentation

Private Sub OpenPowerpoint()
    Set PPT = New PowerPoint.Application

    PPT.Visible = True
    Set PPT_pres = PPT.Presentations.Open(FileName:="C:\Users\aofarrell\Desktop\CYB\Weekly Pack Update - Template.pptx")
    PPT_pres.Slides(2).Select
End Sub

Private Sub CopyToPowerPoint()
    If PPT Is Nothing Then Exit Sub
    If PPT_pres Is Nothing Then Exit Sub

    Dim rng As Range
    Dim mySlide As Object
    Dim myShape As Object

    Set mySlide = PPT_pres.Slides(2)

    'Copy Range from Excel

    Set rng = ThisWorkbook.Sheets("Triggers").Range("B6:Z33")

    'Copy Excel Range
    rng.Copy

    'Paste to PowerPoint and position
    PPT.WindowState = 2
    mySlide.Shapes.PasteSpecial DataType:=0
    Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

    'Set position:
    myShape.Left = 20
    myShape.Top = 70
    myShape.Width = 675
    myShape.Height = 400

    'Clear The Clipboard
    Application.CutCopyMode = False
    Application.Wait (Now + TimeValue("00:00:01"))

End Sub

（另外：如果我将图像从Excel复制到PowerPoint，通常会使用Range.CopyPicture xlPrinter而不是Shapes.PasteSpecial ，它会根据您的屏幕分辨率更改图像的大小）