结合两段VBA代码，用于PPT

Question

我已经找到、更正和测试了一些用于处理 Powerpoint 中的图表的代码。

第一部分是使图的大小相同并正确放置它们（假设幻灯片上有两个图），如下所示：

Sub ProcessAllSlides()

Dim sld As Slide
Dim Shp As Shape

For Each sld In ActivePresentation.Slides
    Call SetChartSizeAndPosition(sld.Shapes(1), 30, 120, 320, 240)
    Call SetChartSizeAndPosition(sld.Shapes(2), 370, 120, 320, 240)
Next

End Sub

Sub SetChartSizeAndPosition(Shp As Shape, Left As Single, Top As Single, Width As Single, Height As Single)

With Shp
    .Left = Left
    .Top = Top
    .Width = Width
    .Height = Height
End With

End Sub

这适用于演示文稿中的所有幻灯片。我希望它只在活动幻灯片上起作用。

第二部分应该格式化绘图区域（而不是图表区域）。见下文：

Sub SizePlotArea()

Dim oSld As Slide
Dim oCht As Chart

Set oCht = ActiveWindow.Selection.ShapeRange(1).Chart

With oCht.PlotArea
    ' Edit these values as needed
    ' Change the following lines to e.g. Msgbox .Left etc
    ' to get the values of the chart you want to match others TO
    .Left = 0
    .Top = 0
    .Height = 220
    .Width = 300
End With

End Sub

理想情况下，我想将两者结合起来，以便为活动幻灯片上的所有（两个）图表完成它们。

任何人有任何提示？

Answer 1

试试下面的Merged Sub，在代码的 cmets 中进行解释。

Option Explicit

Sub ProcessAllSlides()

Dim sld As Slide
Dim Shp As Shape
Dim oCht As Chart
Dim i As Long
Dim ChartIndex As Long

' set the Active Slide
Set sld = Application.ActiveWindow.View.Slide

ChartIndex = 1

' --- loop through the Slide shapes and search for the Shape of type chart
For i = 1 To sld.Shapes.Count
    If sld.Shapes(i).HasChart = msoTrue Then  ' if current shape is a chart
        Set Shp = sld.Shapes(i)
        Set oCht = Shp.Chart

        If ChartIndex = 1 Then ' first chart
            SetChartSizeAndPosition Shp, 30, 120, 320, 240
            ChartIndex = ChartIndex + 1

        ElseIf ChartIndex = 2 Then ' second chart
            SetChartSizeAndPosition Shp, 370, 120, 320, 240
        End If

        With oCht.PlotArea
            ' Edit these values as needed
            ' Change the following lines to e.g. Msgbox .Left etc
            ' to get the values of the chart you want to match others TO
            .Left = 0
            .Top = 0
            .Height = 220
            .Width = 300
        End With

        Set oCht = Nothing
        Set Shp = Nothing
    End If
Next i

End Sub