如何修改此 VBA 代码以运行 Powerpoint 演示文稿而不是工作表？

Question

A VBA beginner here. I have this problem wherein I have to: cycle through each chart in a given presentation and then adjust its Y axes . I want to automate this process as manually going through each chart and adjusting its axes is tedious.

Because I am a noobie I had to copy a code from the internet and adjust it to my needs. I have done minor adjustments but can not figure out a few things.

1. Is it even possible automate this process?
2. The code was programmed for Excel and can not run on powerpoint, what changes do I make so that it can run error free?
3. Do I need to make any other adjustments to the code?
4. Whenever I run this code on Excel, it does not run through all the charts in the active sheet. I have 17 charts with similar titles. Some charts are adjusted, while some stay as they were. Why is this happening?

    Sub Chartaxes()

Dim cht As ChartObject
Dim srs As Series
Dim FirstTime  As Boolean
Dim MaxNumber As Double
Dim MinNumber As Double
Dim MaxChartNumber As Double
Dim MinChartNumber As Double
Dim Padding As Double

'Input Padding on Top of Min/Max Numbers (Percentage)
  Padding = 0.1  'Number between 0-1

'Optimize Code
  Application.ScreenUpdating = False
  
'Loop Through Each Chart On ActiveSheet
  For Each cht In ActiveSheet.ChartObjects
    
    'First Time Looking at This Chart?
      FirstTime = True
      
    'Determine Chart's Overall Max/Min From Connected Data Source
      For Each srs In cht.Chart.SeriesCollection
        'Determine Maximum value in Series
          MaxNumber = Application.WorksheetFunction.Max(srs.Values)
        
        'Store value if currently the overall Maximum Value
          If FirstTime = True Then
            MaxChartNumber = MaxNumber
          ElseIf MaxNumber > MaxChartNumber Then
            MaxChartNumber = MaxNumber
          End If
        
        'Determine Minimum value in Series (exclude zeroes)
          MinNumber = Application.WorksheetFunction.Min(srs.Values)
          
        'First Time Looking at This Chart?
          FirstTime = False
      Next srs
      
    'Rescale Y-Axis
      cht.Chart.Axes(xlValue).MinimumScale = 0
      cht.Chart.Axes(xlValue).MaximumScale = MaxChartNumber * (1 + Padding)
  
  Next cht

'Optimize Code
  Application.ScreenUpdating = True

End Sub

I am sorry if the question is dumb, let me know in the comments if I should not post this here. Also, let me know if there are better ways of doing this.

Thank you in advance!

Answer 1

Please, try the next adapted version, able to work in Outlook . VBA Outlook does not have Min , Max functions and I built them, too:

Sub ModffCharts()
    Dim sh As Shape, ch As Chart, srs, Padding As Double, FirstTime As Boolean
    Dim MaxChartNumber As Double, MaxNumber As Double, MinNumber As Double
    
    Padding = 0.1
    FirstTime = True
    For Each sh In Application.ActiveWindow.View.Slide.Shapes 'shapes of the active slide...
        If sh.HasChart = msoTrue Then
            Set ch = sh.Chart
            Debug.Print ch.SeriesCollection.Count
            For Each srs In ch.SeriesCollection
               'Determine Maximum value in Series
               MaxNumber = MaX(srs.Values)
        
                'Store value if currently the overall Maximum Value
                  If FirstTime = True Then
                        MaxChartNumber = MaxNumber
                  ElseIf MaxNumber > MaxChartNumber Then
                        MaxChartNumber = MaxNumber
                  End If
                
                'Determine Minimum value in Series
                  MinNumber = MiN(srs.Values)
                  
                'First Time Looking at This Chart?
                  FirstTime = False
            Next srs
            ch.Axes(xlValue).MinimumScale = 0
            ch.Axes(xlValue).MaximumScale = MaxChartNumber * (1 + Padding)
        End If
   Next sh
End Sub

Function MaX(arr) As Double
    Dim i As Long, Mx As Double
    For i = LBound(arr) To UBound(arr)
       If arr(i) > Mx Then Mx = arr(i)
    Next i
    MaX = Mx
End Function
Function MiN(arr) As Double
    Dim i As Long, Mn As Double
    Mn = MaX(arr)
    For i = LBound(arr) To UBound(arr)
        If arr(i) < Mn Then Mn = arr(i)
    Next i
    MiN = Mn
End Function

Please, test it and send some feedback.