VBAで100%積み上げ縦棒のグラフのタイプグラフタイプを変更したい。

Question

表1の表を使い、VBAで100&積み上げ縦棒のグラフを作りたいと思います。

下記のコードで、100&積み上げ縦棒のグラフを作りました。

Sub Create_Rough_Graph()

B_Column = 2

Range("B" & B_Column + 1, "D" & B_Column + 6).Select
ActiveSheet.Shapes.AddChart2(297, xlColumnStacked100).Select
ActiveChart.SetSourceData Source:=Range("Sheet1!$B$3:$D$8")

End Sub

このコードを実行した結果は、以下の通りです。

このグラフを、下記のような100&積み上げ縦棒のグラフに変更したいのですが、
VBAでどう書けばわかりません。

もしグラフのスタイルの方法をご存じの方がいらっしゃれば、
ご教示頂ければ幸いです。

Comments

[ttyp03]

一つ目を作ってから二つ目に変更したいのでしょうか？
最初から二つ目を作るのとは違うのでしょうか？
マクロの記録である程度何をすればいいかはわかると思いますが、試していますか？

[poorprogramer]

おっしゃる通り最初から二つ目のグラフを作れればよいです。マクロの記録も使いました。記録したマクロを実行すると、1つ目のグラフになってしまいます。何回もマクロの記録を使っても、どうようの結果です。ネットも調べてみましたが、該当するものが見つけられなかったしだいです。

Answer 1

こんな感じで。
軸の転換をしています。
最後の.Legend.LegendEntries(3).Deleteは
3行目が空白行なので削除しています。

Sub Create_Rough_Graph()

Dim r As Range
Dim fig As Shape
Dim B_Column As Long

B_Column = 2

Set r = Range("B" & B_Column + 1, "D" & B_Column + 6)
Set fig = ActiveSheet.Shapes.AddChart2(297, xlColumnStacked100)

With fig.Chart
    .SetSourceData r
    .PlotBy = xlRows
    .HasLegend = True
    .Legend.Position = xlLegendPositionBottom
    .Legend.LegendEntries(3).Delete
End With

End Sub

Comments

[poorprogramer]

ありがとうございます。自分のしたい事ができました。ご連絡頂いたコードをもとに、勉強していきます。ありがとうございました。