プログラム

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

スポンサーリンク

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

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


  • 領域設定BOX

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


  • 領域設定

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


  • 完成です

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


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
  20. '文字列から数字へ変換
  21.     iRowUpper = Val(strRowUpper)
  22.     iRowLower = Val(strRowLower)
  23.     iColumnLeft = Val(strColumnLeft)
  24.     iColumnRight = Val(strColumnRight)
  25. 'シートの名前を取得
  26.     Dim sheetName As String
  27.     sheetName = ActiveSheet.Name
  28. '---------------------------------
  29. 'グラフ作成の領域を設定
  30. ' Range(Cells(iRowUpper, iColumnLeft + 1), Cells(iRowLower, iColumnRight)).Select
  31. '散布図を選択
  32.     ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select
  33. 'ソースデータをセット
  34.     Dim strSourceData As String
  35.     strSourceData = sheetName & "!" & Cells(iRowUpper, iColumnLeft + 1).Address & ":" & Cells(iRowLower, iColumnRight).Address
  36.     ActiveChart.SetSourceData Source:=Range(strSourceData)
  37. 'データを追記
  38.     ActiveChart.SetElement (msoElementDataLabelTop)
  39. 'データ表示を選択
  40.     ActiveChart.FullSeriesCollection(1).DataLabels.Select
  41. '表示するラベルを指定
  42.     Dim strSourceLabel As String
  43.     strSourceLabel = sheetName & "!" & Cells(iRowUpper + 1, iColumnLeft).Address & ":" & Cells(iRowLower, iColumnLeft).Address
  44.     ActiveChart.SeriesCollection(1).DataLabels.Format.TextFrame2.TextRange. _
  45.         InsertChartField msoChartFieldRange, strSourceLabel, 0
  46.     Selection.ShowRange = True
  47.     Selection.ShowValue = False
  48. FIN:
  49.     Err.Clear
  50. End Sub

スポンサーリンク

-プログラム
-,

© 2021 ふじ・ふじブログ