使用 VBA 在 powerpoint 中重新排列图表

Question

我使用 VBA 在 Excel 中创建了一些图表。现在我想将它发送到我的 PP 模板并在同一张幻灯片中排列 4 个图表，然后跳到下一张幻灯片并添加另外 4 个图表。所有图表都需要调整大小和重新排列。我设法导出了前 4 个图表，但是当我想排列它们并调整尺寸时，我运行遇到了问题。我的 VBA 经验有限，没有 VBA 与 MS PP 一起使用的经验。

到目前为止我的代码：

    Dim PPT As Object
    Dim chr
    Set PPT = CreateObject("Powerpoint.Application")
    PPT.Visible = True
    PPT.Presentations.Open Filename:="C:\VBA Projects\XXX\XXX.ppt"
'    Set PPT = Nothing
    PPT.ActiveWindow.View.GotoSlide 4
    For Each chr In Sheets("Output").ChartObjects
        chr.Select
        ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        PPT.ActiveWindow.View.Paste
    Next chr

End Sub

如何在图表之间进行选择并单独操作它们？

谢谢

Answer 1

将图表粘贴到幻灯片后，您可以使用以下代码对当前粘贴的图表进行引用和设置属性。

    With PPT.ActiveWindow.View.Slide
        With .Shapes(.Shapes.Count)
            'set properties for shape
            '
            '
        End With
    End With

顺便说一句，我建议你更换...

ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

和

chr.Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

否则，如果包含图表的作品sheet 不是活动的 sheet。

编辑

以下代码将遍历 sheet“输出”中的每个 ChartObject 对象，然后将每个对象复制到 PowerPoint 演示文稿，以便每张幻灯片包含 4 个图表，从第 4 张幻灯片开始。根据需要更改属性设置。

Const START_LEFT_POS As Long = 25
Const START_TOP_POS As Long = 60
Const GAP As Long = 30 'gap between charts

Dim LeftPos As Long
LeftPos = START_LEFT_POS

Dim TopPos As Long
TopPos = START_TOP_POS

Dim NextSlideIndex As Long
NextSlideIndex = 4

PPT.ActiveWindow.View.GotoSlide NextSlideIndex

With Sheets("Output")
    Dim ChrtIndex As Long
    For ChrtIndex = 1 To .ChartObjects.Count
        .ChartObjects(ChrtIndex).Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        PPT.ActiveWindow.View.Paste
        With PPT.ActiveWindow.View.slide
            With .Shapes(.Shapes.Count)
                .Left = LeftPos
                .Top = TopPos
                .Width = 200
                .Height = 200
                If ChrtIndex Mod 2 = 1 Then
                    LeftPos = LeftPos + .Width + GAP
                Else
                    LeftPos = START_LEFT_POS
                    TopPos = TopPos + .Height + GAP
                End If
            End With
        End With
        If ChrtIndex Mod 4 = 0 Then
            LeftPos = START_LEFT_POS
            TopPos = START_TOP_POS
            NextSlideIndex = NextSlideIndex + 1
            PPT.ActiveWindow.View.GotoSlide NextSlideIndex
        End If
    Next ChrtIndex
End With

使用 VBA 在 powerpoint 中重新排列图表

rearrange charts in powerpoint using VBA

excel

vba

charts

powerpoint