ポートフォリオの円グラフ作成コード
ポートフォリオの円グラフ作成用のコードです。詳しくはこちらの記事で
コード
Sub ポートフォリオ集約()
Dim a As Long
Dim b As Long
a = 4
b = 1
Sheet4.Range("f3:i3").Copy '寄与率をコピーする
Do While Sheet3.Cells(a, 4).Value <> "" '空欄まで繰り返す
If Sheet3.Cells(a, 4).Value = 0 Then '所得額が0ならば、、、
Else '所得額が0以外ならば
Sheet4.Cells(b + 5, 2).Value = Sheet3.Cells(a, 2).Value '銘柄名をコピーする
Sheet4.Cells(b + 5, 3).Value = Sheet3.Cells(a, 4).Value '所得額をコピーする
Sheet4.Cells(b + 5, 4).Value = Sheet3.Cells(a, 5).Value '評価額をコピーする
Sheet4.Cells(b + 5, 5).Value = Sheet3.Cells(a, 14).Value '予想配当をコピーする
Sheet4.Cells(b + 5, 6).Select '寄与率の選択をして
ActiveSheet.Paste '寄与率をペーストする
b = b + 1 '書出し先の行を一行下げる
End If '書き出し終了
a = a + 1 '参照元の行を一行下げる
Loop '繰り返し
Application.CutCopyMode = False 'コピーをクリア
With ActiveSheet.Shapes.AddChart.Chart 'グラフを作成（以下条件）
.ChartType = xlPie '円グラフ
.SetSourceData Range(Cells(4, 2), Cells(b + 4, 3)) 'データ元の選択
End With
With ActiveSheet.ChartObjects 'グラフの大きさを変更（以下条件）
.Height = 300 '縦を300に
.Width = 500 '横を500に
End With
ActiveSheet.ChartObjects(1).Select 'グラフを選択
ActiveChart.SetElement (msoElementLegendNone) '凡例を表示しない
ActiveChart.SetElement (msoElementDataLabelBestFit) 'データラベルの自動調整を入れる
ActiveChart.FullSeriesCollection(1).DataLabels.Select 'データラベルを選択
Selection.ShowCategoryName = True '分類名を表示
Selection.Separator = "" & Chr(13) & "" '改行で表示
Selection.ShowPercentage = True '%を表示する
Selection.ShowLegendKey = -1 '凡例マーカーをつける
Selection.Format.TextFrame2.WordWrap = msoFalse 'テキストを折り返す
With Selection.Format.Line '凡例の枠線を編集（以下条件）
.Visible = msoTrue '枠線を表示
.ForeColor.ObjectThemeColor = msoThemeColorText1 '黒色にする
End With
With Selection.Format.Fill '凡例の塗りつぶしを編集（以下条件）
.Visible = msoTrue '塗りつぶしを表示する
.ForeColor.ObjectThemeColor = msoThemeColorBackground1 '白色にする
.Solid 'パターンなし
End With
End Sub
