Dec 27 2019 11:03 PM - edited Dec 28 2019 01:40 AM
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 do that. Now all the data is in the same range for all the sheets across the workbook, Need to create a chart where I need a combo chart type which has been prepared in the workbook. Need some help to make them as I have a very little time to make it work. As I do not have any knowledge about VBA hence this post. Would be very thankful for your help.
Attaching the file for reference.
Regards,
Aditya
Dec 28 2019 08:50 AM
You may try something like this...
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
.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
Dec 29 2019 06:42 AM
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
Dec 29 2019 08:00 AM
SolutionPlease 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.
Apr 15 2021 08:54 AM
How could the above code be adapted in case the excel workbook is not a report Pivot table?
See attached.
thank you in advance.
Dec 29 2019 08:00 AM
SolutionPlease 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.