excel - 如何使用 VBA 将我的图片放置在现有 powerpoint 幻灯片的幻灯片中心？

Question

首先，我的图表被复制为图片，当我尝试粘贴它时，对象不支持此属性或方法错误发生在 行对于 PPTPres.Slides 中的每个 oSh (28) .但最终，我希望将我的图片粘贴在幻灯片 28 的中心，并且稍微小一些。谁能告诉我我在哪里做错了，我应该如何纠正它？

 Option Explicit

 Sub ExportChartsToPowerPoint_SingleWorksheettesting()

    'Declare PowerPoint Variables
    Dim PPTApp As Object
    Dim PPTPres As Object
    Dim PPTShape As Object
    Dim mySlide As Object
    Dim myslide2 As Object

        Dim i As Long


    'Declare Excel Variables
    Dim Chrt As ChartObject

If PPTApp Is Nothing Then _
Set PPTApp = CreateObject(class:="PowerPoint.Application")

On Error GoTo 0
        PPTApp.Visible = True

    'Create new presentation in the PowerPoint application.
      Set PPTPres = PPTApp.Presentations.Open(Filename:="\\fab2crp-nas1\home22\kkang2\Profile\Desktop\myassignment3\mypresentationsample.pptx")

   Dim ppSlide As PowerPoint.Slide
        Set ppSlide = PPTPres.Slides(28)

        Dim j As Integer
        For j = ppSlide.Shapes.Count To 1 Step -1
            If ppSlide.Shapes(j).Type = msoPicture Then
                ppSlide.Shapes(j).Delete
            End If
        Next j


With PPTPres.Slides(28)
Sheets(4).Range("A1:M34").CopyPicture
            ppSlide.Shapes.Paste
End With


    Dim oSh As Shape

        For Each oSh In PPTPres.Slides(28) '<---object doesn't support this property or method
            With oSh
                If .Type = msoLinkedPicture _
                Or .Type = msoPicture Then

                ' position it to taste
                .Left = 100
                .Top = 100

                End If
            End With
        Next    ' Shape

End Sub

目前



预期的



调试打印

Answer 1

试试这个(示例代码):

Sub Tester()

    Dim PPTApp As Object
    Dim PPTPres As Object
    Dim ppSlide As PowerPoint.Slide
    Dim Chrt As ChartObject
    Dim oSh 'As ShapeRange
    Dim pgSet

    'using already open PPT for testing....
    Set PPTApp = GetObject(, "PowerPoint.Application") 'get open ppt
    Set ppSlide = PPTApp.Presentations(1).Slides(1)    'the open presentation
    Set pgSet = PPTApp.Presentations(1).PageSetup      'for slide width/height

    Sheets(1).Range("A1:M34").CopyPicture
    Set oSh = ppSlide.Shapes.Paste() '<< get the pasted shape

    'center on slide
    With oSh
        .Left = (pgSet.SlideWidth - .Width) / 2
        .Top = (pgSet.SlideHeight - .Height) / 2
    End With

End Sub