VBA 棒グラフを自動で作ってみよう

Option Explicit

Sub 棒グラフ()

Call C
Call D
Call E

End Sub

Function C()
Range("C2:C4").Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("Sheet3!$C$2:$C$4")
ActiveChart.FullSeriesCollection(1).Name = "=Sheet3!$A$2"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(2).Name = "=Sheet3!$A$5"
ActiveChart.FullSeriesCollection(2).Values = "=Sheet3!$C$5:$C$7"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(3).Name = "=Sheet3!$A$8"
ActiveChart.FullSeriesCollection(3).Values = "=Sheet3!$C$8:$C$10"
ActiveChart.FullSeriesCollection(3).XValues = "=Sheet3!$B$2:$B$4"
ActiveChart.SetElement (msoElementLegendRight)

ActiveSheet.ChartObjects(1).Chart.HasTitle = True
ActiveSheet.ChartObjects(1).Chart.ChartTitle.Text = Cells(1, 3).Value

ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Cells(2, 9).Value
End Function

Function D()
Range("D2:D4").Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("Sheet3!$D$2:$D$4")
ActiveChart.FullSeriesCollection(1).Name = "=Sheet3!$A$2"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(2).Name = "=Sheet3!$A$5"
ActiveChart.FullSeriesCollection(2).Values = "=Sheet3!$D$5:$D$7"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(3).Name = "=Sheet3!$A$8"
ActiveChart.FullSeriesCollection(3).Values = "=Sheet3!$D$8:$D$10"
ActiveChart.FullSeriesCollection(3).XValues = "=Sheet3!$B$2:$B$4"
ActiveChart.SetElement (msoElementLegendRight)

ActiveSheet.ChartObjects(2).Chart.HasTitle = True
ActiveSheet.ChartObjects(2).Chart.ChartTitle.Text = Cells(1, 4).Value

ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Cells(2, 9).Value
End Function

Function E()
Range("E2:E4").Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("Sheet3!$E$2:$E$4")
ActiveChart.FullSeriesCollection(1).Name = "=Sheet3!$A$2"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(2).Name = "=Sheet3!$A$5"
ActiveChart.FullSeriesCollection(2).Values = "=Sheet3!$E$5:$E$7"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(3).Name = "=Sheet3!$A$8"
ActiveChart.FullSeriesCollection(3).Values = "=Sheet3!$E$8:$E$10"
ActiveChart.FullSeriesCollection(3).XValues = "=Sheet3!$B$2:$B$4"
ActiveChart.SetElement (msoElementLegendRight)

ActiveSheet.ChartObjects(3).Chart.HasTitle = True
ActiveSheet.ChartObjects(3).Chart.ChartTitle.Text = Cells(1, 5).Value

ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Cells(2, 9).Value
End Function

結果　↓