0

I have to cycle through each chart in a given presentation and adjust its Y axis.

I copied code from the internet and adjusted it.

  1. The code was programmed for Excel.
    What changes do I make so it can run in PowerPoint?
  2. In Excel, I have 17 charts with similar titles in the active sheet.
    Some charts are adjusted, while some stay as they were.
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

Images for reference:

One of the slides

Linked data (an excel file)

Community
  • 1
  • 1
  • Aren't the charts in discussion linked to a workbook or more? – FaneDuru Aug 22 '22 at 11:19
  • Hi, The charts are linked to a workbook, but the axes do not update automatically in the slides after I run this code in excel. – prayag purohit Aug 22 '22 at 12:11
  • Is the code running in Excel or PowerPoint ? Also you can't use `For Each cht In ActiveSheet.ChartObjects` to loop through charts in PowerPoint, you will have to loop through Slides and Shapes, refer to [this post](https://stackoverflow.com/questions/45313970/update-powerpoint-chart-using-vba) – Thomas C. Aug 22 '22 at 12:28
  • I have a code for excel, but Idk know how I can run it in powerpoint. Thank you for a reference, I'll look into it. – prayag purohit Aug 22 '22 at 12:51

1 Answers1

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
    For Each sh In Application.ActiveWindow.View.Slide.Shapes 'shapes of the active slide...
        If sh.HasChart = msoTrue Then

            Set ch = sh.Chart
            FirstTime = True
            '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.

Edited:

Please, test the updated version. It will use the same maximum scale for first three chart, calculate it for the fourth and use it for rest of charts:

Sub ModffCharts_bis()
    Dim sh As Shape, ch As Chart, srs, Padding As Double, FirstTime As Boolean
    Dim MaxChartNumber As Double, MaxNumber As Double, MinNumber As Double
    Dim i As Long
    
    Padding = 0.1
    FirstTime = True
    For Each sh In Application.ActiveWindow.View.Slide.Shapes
        If sh.HasChart = msoTrue Then
            Set ch = sh.Chart
            i = i + 1
            Select Case i
                Case 2, 3: GoTo OverCalculation
                Case Is > 4: GoTo OverCalculation
            End Select
            
            '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
OverCalculation:
            ch.Axes(xlValue).MinimumScale = 0
            ch.Axes(xlValue).MaximumScale = MaxChartNumber * (1 + Padding)
        End If
   Next sh
End Sub
FaneDuru
  • 38,298
  • 4
  • 19
  • 27
  • Hi Fane, Thank you for putting so much effort into it. I tried to run the macro in the PPT but it did not adjust the charts. No errors. Could it be because there are multiple charts in each slide? – prayag purohit Aug 24 '22 at 05:42
  • @prayag purohit The above code imitates the code working in Excel. I mean, instead of working on active sheet, it works **only on the active slide**. Did you analyze if it does what you need **on the active slide**? The code can be adapted to work on all slides, but you firstly must confirm that it does the job as you want on the **active one**... – FaneDuru Aug 24 '22 at 06:37
  • I realized that it only works on active slide. But still it does not work as expected. I noticed that every chart axes in each slide takes a single value. i.e. All charts in slide 1 takes the value 50K, All chart axes in slide 2 takes the value 20K. Also the charts don't look at expected, as in there is a difference between the expected axis value and the value that the macro assigns. – prayag purohit Aug 24 '22 at 07:29
  • @prayag purohit OK. Please, test the updated code and send some feedback. `FirstTime = True` should be inside the first iteration. I did not pay too much attention to what the code wants doing... I only tried adapting it to work in PowerPoint VBA. For instance, I now could see that `MinNumber` is calculated for nothing, never being used... – FaneDuru Aug 24 '22 at 08:37
  • Hey Fane, The code works really well. Thank you. I have a update to the problem - In the active slide I have 6 Charts, can I adjust the scale of the 1st chart (Max number + Padding), copy that scale to chart 2 and 3. Again adjust the scale of 4th chart (Max number + Padding) and then copy that scale to chart 5 and 6? It would be a great help if this can happen – prayag purohit Aug 25 '22 at 11:41
  • @prayag purohit Not sure that I am able to get you... What do you mean by "copy that scale"? To use the same `MaxChartNumber * (1 + Padding)` calculated for the first chart, or (really) to copy the first chart `SeriesCollection` values? – FaneDuru Aug 26 '22 at 07:59
  • Oh im sorry, I want to apply the MaxChartNumber * (1+Padding) [Maximum scale] calculated for the first chart to the next two charts. Then move on to the forth chart calculate a new MaxChartNumber * (1+Padding) and then apply this to the last two charts. You can see the image for reference. – prayag purohit Aug 26 '22 at 08:28
  • @prayag purohit OK. You need a variable to be incremented of each chart iteration and a `Select Case`. Forget it... I will edit the code and add a new version to be tested for this new requirement. More complicated to explain, than doing it... Edited and posted the new version. – FaneDuru Aug 26 '22 at 08:50
  • Oh my god you're a god to me. Thanks – prayag purohit Aug 29 '22 at 04:08