使用vba在ppt中排列图片

Question

我正在尝试使用 VBA 在 ppt 中粘贴图表。我从 Excel 中的一个范围内复制了一个图表并将其粘贴到 ppt 中。我的问题是调整大小和排列，使其适合 ppt 模板幻灯片。我想在每张幻灯片上粘贴一张图片。到目前为止，我有：

 Dim PPT As Object
    Set PPT = CreateObject("Powerpoint.application")
    PPT.Visible = True
    PPT.Presentations.Open Filename:="x:\xx.pptx"
    
    Const START_LEFT_POS = 100
    Const START_TOP_POS = 5
    Const gap As Long = 5

    Dim LeftPos As Long
    LeftPos = START_LEFT_POS

    Dim TopPos As Long
    TopPos = START_TOP_POS

    Dim NextSlideIndex As Long
    NextSlideIndex = 2
 
    PPT.ActiveWindow.View.gotoslide NextSlideIndex
    
    Dim range_1 As Range

    Dim AllRanges(1 To 5) As Variant
    
    Sheets("Charts").Activate
    
    AllRanges(1) = "J132:Q149": AllRanges(2) = "J150:Q168": AllRanges(3) = "J169:Q183": AllRanges(4) = "S139:AC149": AllRanges(5) = "V166:Y180"
    
    Dim ChrtIndex As Long
    
    For ChrtIndex = 1 To 5
        Set range_1 = Range(AllRanges(ChrtIndex))
        range_1.CopyPicture appearance:=xlScreen, Format:=xlPicture
        PPT.ActiveWindow.View.PasteSpecial DataType:=2
        With PPT.ActiveWindow.View.slide
            With .Shapes(ChrtIndex)
            .Left = LeftPos
            .Width = 160
            .Height = 155
            End With
        End With
        PPT.ActiveWindow.View.gotoslide NextSlideIndex + 1

    Next ChrtIndex

谢谢！

Answer 1

利用 PowerPoint 中已内置的功能。创建包含一个图表或内容占位符的自定义布局。然后在 VBA 中，使用该布局。粘贴的图表将自动填充设计大小和位置的占位符。这是设置幻灯片布局的典型行，以及从其名称中获取正确布局的函数：

objSlide.CustomLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(GetLayoutIndexFromName("Chart Layout", ActivePresentation.Designs(1)))

Function GetLayoutIndexFromName(sLayoutName As String, oDes As Design) As Long
  Dim x As Long
  For x = 1 To oDes.SlideMaster.CustomLayouts.Count
    If oDes.SlideMaster.CustomLayouts(x).Name = sLayoutName Then
      GetLayoutIndexFromName = x
      Exit Function
    End If
  Next
End Function