如何处理 Excel 中的 Powerpoint 图表

Question

我在第二张幻灯片中有一个 PowerPoint 文件和一个图表。 在 Excel 文件中编写宏时，我无法设置图表的高度和宽度。下面是我正在尝试的代码。请注意，我只需要从 Excel 宏中修改高度和宽度。

Sub controlPPT()
    Dim PPT As Object
    Set PPT = CreateObject("PowerPoint.Application")     
    With Application.FileDialog(1)
        .AllowMultiSelect = False
        .Show
        .Filters.Clear
        .Filters.Add "PPT files", "*.pptx"
        .FilterIndex = 1
        If .SelectedItems.Count > 0 Then
            Set slideTwo = PPT.ActivePresentation.Slides(2)
            slideTwo.Shapes(1).Chart.PlotArea.Height = 120
            slideTwo.Shapes(1).Chart.PlotArea.Width = 200
            slideTwo.Shapes(1).Chart.PlotArea.Left = 0
            slideTwo.Shapes(1).Chart.PlotArea.Top = 0
        End If
    End With
End Sub

Answer 1

主要问题是Application.FileDialog 没有打开选定的文件，你应该明确地打开它：

Sub controlPPT()
    Dim pptApp As Object
    Dim pres As Object
    Dim slideTwo As Object

    Set pptApp = CreateObject("PowerPoint.Application")

    With Application.FileDialog(1)
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "PPT files", "*.pptx"
        .FilterIndex = 1
        .Show
        If .SelectedItems.Count > 0 Then
            Set pres = pptApp.Presentations.Open(.SelectedItems(1))
            Set slideTwo = pres.Slides(2)
            slideTwo.Select
            With slideTwo.Shapes(1).Chart.PlotArea
                .Height = 120
                .Width = 200
                .Left = 0
                .Top = 0
            End With
        End If
    End With

    'save/close presentation
    pres.Save
    pres.Close
    'clean up
    Set pres = Nothing
    pptApp.Quit
    Set pptApp = Nothing
End Sub

为了可靠性，我会将slideTwo.Shapes(1) 更改为slideTwo.Shapes("Chart1")，其中“Chart1”应替换为实际图表名称。