マクロを使ってエクセルの散布図にラベルを入れる

前回、手動にて散布図にラベルを追加しましたが、マクロの記録を使って、前回とほぼ同じ工程で作成したマクロに手を加え、汎用のツールを作成しました。

動きは下記のとおりです。

• 領域設定BOX

  マクロを起動すると下図のように、領域設定用のボップアップがでます。

  




• 領域設定

  大陸名～面積までグラフに関係するセルを領域指定し、「ＯＫ」ボタンを押します。

  




• 完成です

  下記のグラフが出来上がります。マクロはラベルを追加するところで終了していますので、これから先は手動で外観を整えてください。

  

VBAのプログラムを掲載します。

最初にグラフに関連するセルを選択しましたが、この領域は文字列を返すRang関数で管理されるため、プログラムの中で、必要な領域を指定しなおすことができません。そのため、Cells関数に変換するところがミソです。

1. Sub Add_Label()
2. '
3.     On Error GoTo FIN '領域の選択BOXでキャンセルされたときにエラーを出さない。
4.     Dim rngGraph As Range
5.     Set rngGraph = Application.InputBox(Prompt:="グラフデータを選択してください。", Type:=8)
6. '
7. '選択した左上と右下のセルアドレスをCells関数で扱えるように数値化します。
8.     Dim strRowUpper As String, strRowLower As String
9.     Dim iRowUpper As Integer, iRowLower As Integer
10. '
11.     Dim strColumnLeft As String, strColumnRight As String
12.     Dim iColumnLeft As Integer, iColumnRight As Integer
13. '
14.     With rngGraph
15.        strRowUpper = .Item(1).Row '左上の行
16.        strRowLower = .Item(.Count).Row '右下の行
17.        strColumnLeft = .Item(1).Column '左上の列
18.        strColumnRight = .Item(.Count).Column '右下の列
19.     End With
21. '文字列から数字へ変換
22.     iRowUpper = Val(strRowUpper)
23.     iRowLower = Val(strRowLower)
24.     iColumnLeft = Val(strColumnLeft)
25.     iColumnRight = Val(strColumnRight)
26. 'シートの名前を取得
27.     Dim sheetName As String
28.     sheetName = ActiveSheet.Name
29. '---------------------------------
30. 'グラフ作成の領域を設定
31. ' Range(Cells(iRowUpper, iColumnLeft + 1), Cells(iRowLower, iColumnRight)).Select
33. '散布図を選択
34.     ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select
35. 'ソースデータをセット
36.     Dim strSourceData As String
37.     strSourceData = sheetName & "!" & Cells(iRowUpper, iColumnLeft + 1).Address & ":" & Cells(iRowLower, iColumnRight).Address
38.     ActiveChart.SetSourceData Source:=Range(strSourceData)
40. 'データを追記
41.     ActiveChart.SetElement (msoElementDataLabelTop)
42. 'データ表示を選択
43.     ActiveChart.FullSeriesCollection(1).DataLabels.Select
44. '表示するラベルを指定
45.     Dim strSourceLabel As String
46.     strSourceLabel = sheetName & "!" & Cells(iRowUpper + 1, iColumnLeft).Address & ":" & Cells(iRowLower, iColumnLeft).Address
47.     ActiveChart.SeriesCollection(1).DataLabels.Format.TextFrame2.TextRange. _
48.         InsertChartField msoChartFieldRange, strSourceLabel, 0
49.     Selection.ShowRange = True
50.     Selection.ShowValue = False
52. FIN:
53.     Err.Clear
54. End Sub