Forum Discussion

Aditya Jadhav's avatar
Aditya Jadhav
Brass Contributor
Dec 28, 2019
Solved

How to create separate chart for each worksheet in a workbook using VBA ?

Hello all,   I have a workbook which contains more than 1000 worksheets in it and got them by using the pivot report filter. Now I need to create chart for each sheet and need help to get a VBA to ...
excel
Macros and VBA
  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Dec 29, 2019

    Aditya Jadhav 

    Please give this a try....

    Sub InsertCharts()
Dim ws As Worksheet
Dim pt As PivotTable
Dim Rng As Range
Dim ch As Chart
For Each ws In ThisWorkbook.Worksheets
    If ws.PivotTables.Count > 0 Then
        Set pt = ws.PivotTables(1)
        Set Rng = pt.TableRange2
        Set ch = ws.Shapes.AddChart(xlLine).Chart
        With ch
            .SetSourceData Source:=Rng
            .FullSeriesCollection("Rainfall ").ChartType = xlColumnClustered
            .FullSeriesCollection("Rainfall ").AxisGroup = 2
            .Axes(xlValue).MinimumScale = 450
            .Axes(xlValue).MaximumScale = 610
            .Axes(xlValue, xlSecondary).MinimumScale = 0
            .Axes(xlValue, xlSecondary).MaximumScale = 60
            .ShowAllFieldButtons = False
            .SetElement (msoElementLegendBottom)
            .HasTitle = True
            .ChartTitle.Characters.Text = ws.Name
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "RWL in m (above MSL)"
            .Axes(xlValue, xlSecondary).HasTitle = True
            .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Rainfall (mm)"
            .ChartArea.Left = Range("L3").Left
            .ChartArea.Top = Range("L3").Top
        End With
    End If
Next ws
End Sub

     

    For PowerPoint question, please open a new question and I am sure other experts would be able to help you.

     

    If that takes care of your original question, please accept the post with the proposed solution as a Best Response/Answer to mark your question as Solved.

     

Aditya Jadhav's avatar
Aditya Jadhav
Brass Contributor
Dec 29, 2019

Subodh_Tiwari_sktneer 

Thank you for the code it really worked very well. But there is one problem I need the primary and secondary axis scale to be fixed. On the primary axis, it needs the scale from 450 to 610 and on the secondary axis, it needs to be from 0 to 60. Can you please tell me how to add that and run it so then it will work completely as per my need.

Also, can you also tell me how can I export all these graphs to a powerpoint presentation where on one slide 4 graphs can be pasted.

 

Regards,

Aditya

 

Subodh_Tiwari_sktneer's avatar
Subodh_Tiwari_sktneer
Silver Contributor
Dec 29, 2019

Aditya Jadhav 

Please give this a try....

Sub InsertCharts()
Dim ws As Worksheet
Dim pt As PivotTable
Dim Rng As Range
Dim ch As Chart
For Each ws In ThisWorkbook.Worksheets
    If ws.PivotTables.Count > 0 Then
        Set pt = ws.PivotTables(1)
        Set Rng = pt.TableRange2
        Set ch = ws.Shapes.AddChart(xlLine).Chart
        With ch
            .SetSourceData Source:=Rng
            .FullSeriesCollection("Rainfall ").ChartType = xlColumnClustered
            .FullSeriesCollection("Rainfall ").AxisGroup = 2
            .Axes(xlValue).MinimumScale = 450
            .Axes(xlValue).MaximumScale = 610
            .Axes(xlValue, xlSecondary).MinimumScale = 0
            .Axes(xlValue, xlSecondary).MaximumScale = 60
            .ShowAllFieldButtons = False
            .SetElement (msoElementLegendBottom)
            .HasTitle = True
            .ChartTitle.Characters.Text = ws.Name
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "RWL in m (above MSL)"
            .Axes(xlValue, xlSecondary).HasTitle = True
            .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Rainfall (mm)"
            .ChartArea.Left = Range("L3").Left
            .ChartArea.Top = Range("L3").Top
        End With
    End If
Next ws
End Sub

 

For PowerPoint question, please open a new question and I am sure other experts would be able to help you.

 

If that takes care of your original question, please accept the post with the proposed solution as a Best Response/Answer to mark your question as Solved.

 

Resources