【VBA】グラフのイベント：応用編

皆さんこんにちは！！
以前、「VBAでのグラフイベント操作」について記事を書きました。

【VBA】グラフのイベント今回はかなりコアな内容で、VBA上級者の方でもあまり使ったことがないであろう、「VBAでのグラフイベント操作」を取り上げたいと思います。...

前回はグラフでイベントをハンドル出来るという部分を解説しました。
大切な部分は次の通りです。
※下記、MicroSoft Docsより引用

既定の設定では、埋め込みグラフでイベントを使用できます。埋め込みグラフを表す Chart オブジェクトでイベントを使用できるようにするには、新しいクラスモジュールを作成し、イベントで Chart オブジェクト型の変数を宣言します
MicroSoft Docs埋め込みグラフでイベントを使用する

Yuu

この記事はVBAのイベントの基本とクラスモジュールの基本を理解していることが前提です。

最低限イベントの動作について理解してから読んでみてください。

Chart オブジェクトのイベントの種類

グラフのイベントは、グラフをアクティブにしたり、グラフを変更することなどで発生します。
グラフでは、次リストのイベントを使用する事が出来ます。

グラフで使用できるイベント

Activate
BeforeDoubleClick
BeforeRightClick
Calculate
Deactivate
MouseDown
MouseMove
MouseUp
Resize
Select

グラフに対してイベントを作成する前に、クラスで WithEvents キーワードを使用して、新しいオブジェクトを作成する必要があります。

詳しくは、こちらをクリックして前回の記事をご覧ください。

ワークシート等と変わらず、複数のイベントを利用することが出来ます。
それでは、すべてのイベントのサンプルコードを紹介します。

イベントの理解がある前提で解説をしていきますので、分からない方はお気軽にコメントを下さい。

Yuu

利用の例を書いていきますが、応用方法や実務に展開するイメージが湧かなかったら気軽にコメント下さいね☆

ダブルクリック【BeforeDoubleClick】

【Activate】は前回の記事で書いてあるので、ダブルクリックのイベントから書いていきます。

グラフのイベントは、どれもクラスで定義して標準モジュールでインスタンス化して利用します。

流れはActivateとすべて同じになるので、前回の記事を理解できた方なら簡単に理解できます。

WorkSheetに適当なグラフを用意しておいてください。

それでは、クラスモジュールを挿入して下記のコードを記述してください。

Option Explicit

Public WithEvents myCht As Chart

Private Sub myCht_BeforeDoubleClick(ByVal ElementID As Long, _
                                    ByVal Arg1 As Long, _
                                    ByVal Arg2 As Long, _
                                    Cancel As Boolean)
    Dim mystr As String
    Select Case ElementID
        Case xlAxis: mystr = "Axis"
        Case xlAxisTitle: mystr = "AxisTitle"
        Case xlDisplayUnitLabel: mystr = "DisplayUnitLabel"
        Case xlMajorGridlines: mystr = "MajorGridlines"
        Case xlMinorGridlines: mystr = "MinorGridlines"
        Case xlPivotChartDropZone: mystr = "PivotChartDropZone"
        Case xlPivotChartFieldButton: mystr = "PivotChartFieldButton"
        Case xlDownBars: mystr = "DownBars"
        Case xlDropLines: mystr = "DropLines"
        Case xlHiLoLines: mystr = "HiLoLines"
        Case xlRadarAxisLabels: mystr = "RadarAxisLabels"
        Case xlSeriesLines: mystr = "SeriesLines"
        Case xlUpBars: mystr = "UpBars"
        Case xlChartArea: mystr = "ChartArea"
        Case xlChartTitle: mystr = "ChartTitle"
        Case xlCorners: mystr = "Corners"
        Case xlDataTable: mystr = "DataTable"
        Case xlFloor: mystr = "Floor"
        Case xlLegend: mystr = "Legend"
        Case xlNothing: mystr = "Nothing"
        Case xlPlotArea: mystr = "PlotArea"
        Case xlWalls: mystr = "Walls"
        Case xlDataLabel: mystr = "DataLabel"
        Case xlErrorBars: mystr = "ErrorBars"
        Case xlLegendEntry: mystr = "LegendEntry"
        Case xlLegendKey: mystr = "LegendKey"
        Case xlSeries: mystr = "Series"
        Case xlTrendline: mystr = "Trendline"
        Case xlXErrorBars: mystr = "XErrorBars"
        Case xlYErrorBars: mystr = "YErrorBars"
        Case xlShape: mystr = "Shape"
    End Select
    MsgBox "要素" & mystr & "がダブルクリックされました" & vbCrLf & _
    "パラメータは" & Arg1 & "と" & Arg2 & "です"
    Cancel = True
End Sub

続いて標準モジュールに次のコードを記述してください。

Option Explicit

Dim myChtCls As New ChartEventCls

Sub InitializeChartEvent()
    Set myChtCls.myCht = Worksheets(1).ChartObjects(1).Chart
End Sub

InitializeChartEvent()を実行することで、クラスがインスタンス化してイベントが利用できるようになります。

基本的はActivateイベントと同じです。
ただ、ダブルクリックはグラフの種類に応じた引数を受け取り、利用できるので様々な活用方法があります。

Arg1とArg2は、グラフの種類によって内容が変わるのでオブジェクトブラウザーなどで確認してみてください。

右クリック【BeforeRightClick】

ここからは、標準モジュールのコードが同じなので、クラスのみ記載しておきます。

Option Explicit

Public WithEvents myCht As Chart

Private Sub myCht_BeforeRightClick(Cancel As Boolean)
    MsgBox Me.myCht.Name & "が右クリックされました"
End Sub

ほぼ、WorkSheetのイベントと同じですね。
皆さん理解されていると思いますが、CancelをTrueにすることで既定の右クリックの動作をキャンセルすることが出来ます。
コンテキストメニューを表示したくない場合、Trueを代入してください。

グラフがアクティブでなくなった時【Deactivate】

Option Explicit

Public WithEvents myCht As Chart
Private Sub myCht_Deactivate()
    MsgBox Me.myCht.Name & "がActiveではなくなりました"
End Sub

Deactivateは利用頻度が少ないかと思います。
私は、初期化ぐらいでしか利用しません。

マウスでクリックしたとき【MouseDown】

Option Explicit

Public WithEvents myCht As Chart
Private Sub myCht_MouseDown(ByVal Button As Long, _
                            ByVal Shift As Long, _
                            ByVal x As Long, _
                            ByVal y As Long)
    Dim mystr As String
    Select Case Shift
        Case 0
        Case 1: mystr = "Shift キー＋"
        Case 2: mystr = "Crrl キー＋"
        Case 4: mystr = "Alt キー＋"
    End Select
    Select Case Button
        Case xlNoButton: mystr = mystr & "不明なボタン"
        Case xlPrimaryButton: mystr = mystr & "第一ボタン"
        Case xlSecondaryButton: mystr = mystr & "第二ボタン"
    End Select
    mystr = mystr & "が押されました" & vbCrLf
    mystr = mystr & "マウスポインタの座標はX:=" & x & "Y:=" & y & "です"
    MsgBox mystr
End Sub

マウスのイベントは下記の部分を見ていただければ分かるように、押されたボタンの種類（左クリック、右クリックなど）を取得することが出来ます。

 Select Case Shift
        Case 0
        Case 1: mystr = "Shift キー＋"
        Case 2: mystr = "Crrl キー＋"
        Case 4: mystr = "Alt キー＋"
    End Select
    Select Case Button
        Case xlNoButton: mystr = mystr & "不明なボタン"
        Case xlPrimaryButton: mystr = mystr & "第一ボタン"
        Case xlSecondaryButton: mystr = mystr & "第二ボタン"
    End Select

グラフの上でマウスを動かしたとき【MouseMove】

Option Explicit

Public WithEvents myCht As Chart
Private Sub myCht_MouseMove(ByVal Button As Long, _
                            ByVal Shift As Long, _
                            ByVal x As Long, _
                            ByVal y As Long)
    Dim mystr As String
    Select Case Shift
        Case 0
        Case 1: mystr = "Shift キー＋"
        Case 2: mystr = "Crrl キー＋"
        Case 4: mystr = "Alt キー＋"
    End Select
    Select Case Button
        Case xlNoButton: mystr = mystr & "不明なボタン"
        Case xlPrimaryButton: mystr = mystr & "第一ボタン"
        Case xlSecondaryButton: mystr = mystr & "第二ボタン"
    End Select
    mystr = mystr & "を押しながらマウスが移動されました" & vbCrLf
    mystr = mystr & "マウスポインタの座標はX:=" & x & "Y:=" & y & "です"
    MsgBox mystr
End Sub

MouseMoveは、私個人的に使ったことがありません。
イベントが走りすぎるので、鬱陶しくなります。

マウスボタンを離したとき【MouseUp】

Option Explicit

Public WithEvents myCht As Chart

Private Sub myCht_MouseUp(ByVal Button As Long, _
                          ByVal Shift As Long, _
                          ByVal x As Long, _
                          ByVal y As Long)
    Dim mystr As String
    Select Case Shift
        Case 0
        Case 1: mystr = "Shift キー＋"
        Case 2: mystr = "Crrl キー＋"
        Case 4: mystr = "Alt キー＋"
    End Select
    Select Case Button
        Case xlNoButton: mystr = mystr & "不明なボタン"
        Case xlPrimaryButton: mystr = mystr & "第一ボタン"
        Case xlSecondaryButton: mystr = mystr & "第二ボタン"
    End Select
    mystr = mystr & "が離されました" & vbCrLf
    mystr = mystr & "マウスポインタの座標はX:=" & x & "Y:=" & y & "です"
    MsgBox mystr
End Sub

マウスでクリックしてボタンを離した時にイベントが発生します。

サイズ変更時【Resize】

Option Explicit

Public WithEvents myCht As Chart
Private Sub myCht_Resize()
    MsgBox myCht.Name & "のサイズが変更されました"
End Sub

グラフを選択時【Select】

Option Explicit

Public WithEvents myCht As Chart
Private Sub myCht_Select(ByVal ElementID As Long, _
                         ByVal Arg1 As Long, _
                         ByVal Arg2 As Long)
    Dim mystr As String
    Select Case ElementID
        Case xlAxis: mystr = "Axis"
        Case xlAxisTitle: mystr = "AxisTitle"
        Case xlDisplayUnitLabel: mystr = "DisplayUnitLabel"
        Case xlMajorGridlines: mystr = "MajorGridlines"
        Case xlMinorGridlines: mystr = "MinorGridlines"
        Case xlPivotChartDropZone: mystr = "PivotChartDropZone"
        Case xlPivotChartFieldButton: mystr = "PivotChartFieldButton"
        Case xlDownBars: mystr = "DownBars"
        Case xlDropLines: mystr = "DropLines"
        Case xlHiLoLines: mystr = "HiLoLines"
        Case xlRadarAxisLabels: mystr = "RadarAxisLabels"
        Case xlSeriesLines: mystr = "SeriesLines"
        Case xlUpBars: mystr = "UpBars"
        Case xlChartArea: mystr = "ChartArea"
        Case xlChartTitle: mystr = "ChartTitle"
        Case xlCorners: mystr = "Corners"
        Case xlDataTable: mystr = "DataTable"
        Case xlFloor: mystr = "Floor"
        Case xlLegend: mystr = "Legend"
        Case xlNothing: mystr = "Nothing"
        Case xlPlotArea: mystr = "PlotArea"
        Case xlWalls: mystr = "Walls"
        Case xlDataLabel: mystr = "DataLabel"
        Case xlErrorBars: mystr = "ErrorBars"
        Case xlLegendEntry: mystr = "LegendEntry"
        Case xlLegendKey: mystr = "LegendKey"
        Case xlSeries: mystr = "Series"
        Case xlTrendline: mystr = "Trendline"
        Case xlXErrorBars: mystr = "XErrorBars"
        Case xlYErrorBars: mystr = "YErrorBars"
        Case xlShape: mystr = "Shape"
    End Select
    MsgBox "要素" & mystr & "が選択されました" & vbCrLf & _
    "パラメータは" & Arg1 & "と" & Arg2 & "です"
End Sub

セレクトイベントとダブルクリックイベントは共存できません。

同じくアクティベートなども共存できません。

グラフイベントの補足

MicroSoftの公式ドキュメントでは、イベントがもう一つ（SeriesChange）紹介されていますが、このイベントはExcel2003までのイベントとなっていて現在は使用できません。

これらのイベントを全て覚える必要はありません。
「グラフでもイベントをハンドル出来る」ということだけ覚えていれば大丈夫です。

グラフイベントの応用例

ここまでで、グラフで発生するイベントをVBAでハンドルする方法を紹介してきましたが、具体的な活用方法が浮かばないかもしれないので、一つだけ応用例を紹介します。

グラフのポイントをダブルクリックで前後の値を表示

クラスモジュールに下記を記載してください。
※標準モジュールは今までと同じです。

Option Explicit

Public WithEvents myCht As Chart

Private Sub myCht_BeforeDoubleClick(ByVal ElementID As Long, _
                                    ByVal Arg1 As Long, _
                                    ByVal Arg2 As Long, _
                                    Cancel As Boolean)
    Dim mySeries As Series
    Dim myF      As String
    Dim myAd     As String
    Dim myRng  As Range
    Dim myMin    As Long
    Dim myMax    As Long
    Dim myStr As String
    Dim i        As Long
    If ElementID = xlSeries Then
        If Arg2 <> -1 Then
            myF = myCht.SeriesCollection(Arg1).Formula
            If myF Like "=SERIES(*" Then
                myF = Mid(myF, 9)
                For i = 1 To 3
                    myAd = Left(myF, InStr(myF, ",") - 1)
                    myF = Mid(myF, InStr(myF, ",") + 1)
                Next
                If Len(myAd) > 0 Then
                    Set myRng = Evaluate(myAd)
                    myMin = WorksheetFunction _
                    .Max(1, Arg2 - 1)
                    myMax = WorksheetFunction _
                    .Min(Arg2 + 1, myRng.Cells.Count)
                    For i = myMin To myMax
                        myStr = myStr _
                    & myRng.Cells(i).Value & vbCrLf
                    Next
                    MsgBox myStr
                End If
            End If
            Cancel = True
        End If
    End If
End Sub

ポイントは引数「Arg1.Formula」を見て元データのセルを特定している部分です。

実務で使うには「If」が3重になっていたりして、見にくいコードなので適当に関数化して、メンテナンスしやすいコードにして下さい。