グラフ軸目盛りの範囲・間隔を統一するマクロ

以下のグラフを見てください。

よくあるグラフなんですが、このグラフ群には一つ大きな問題がありますね。

そう

これです。

せっかくの同形式グラフなのに、ここが違うとグラフ間で比較ができません。

よってこれを直すために、
すべてのグラフの軸上限・軸下限・目盛り幅を直して回る
という作業はかなりの人がやった経験があるのではないでしょうか。

今回はこれを自動化するマクロを紹介します。

ついでに「100%上限のグラフなのに120%で作りやがる問題」にも対応！

実行型の便利マクロですので、
Excel起動時に裏で開かれる「個人用マクロブック」などに搭載して使ってください。

ショートカットキーに登録したり、ツールバーやリボンにボタン配置すると便利です。

なお、本マクロは「選択中のすべてのグラフを統一設定するマクロ」のため、
「選択セル範囲に重なる図形を全選択するマクロ」と非常に相性が良いです。

せっかくなので、ご一緒にお持ち帰りください。

ソースコード

' グラフ軸目盛の統一
Sub 選択中のグラフの軸目盛を統一する()

    ' 複数の図形を選択した状態以外は実行しない
    If TypeName(Selection) <> "DrawingObjects" Then Exit Sub

    Dim ws対象シート As Worksheet
    Set ws対象シート = ActiveSheet
    
    ' 選択グラフのリストをコレクションに格納
    Dim Clct対象グラフリスト As New Collection
    Dim 図形オブジェクト
    For Each 図形オブジェクト In Selection
        If 図形オブジェクト.ShapeRange.Type = msoChart Then
            
            Clct対象グラフリスト.Add ws対象シート.ChartObjects(図形オブジェクト.Name)
            
        End If
    Next
    
    If Clct対象グラフリスト.Count = 0 Then
        MsgBox "選択図形内にグラフがありません。": Exit Sub
    End If
    
    ' 選択グラフの目盛り上下限の最大・最小値を取得（InputBox初期値などに使用）
    Dim Max目盛り上限 As Double: Max目盛り上限 = -10 ^ 16
    Dim Min目盛り下限 As Double: Min目盛り下限 = 10 ^ 16
    
    Dim グラフ As ChartObject
    For Each グラフ In Clct対象グラフリスト
        
        Dim 現目盛り上限 As Double
        現目盛り上限 = グラフ.Chart.Axes(xlValue).MaximumScale
        If Max目盛り上限 < 現目盛り上限 Then Max目盛り上限 = 現目盛り上限
        
        Dim 現目盛り下限 As Double
        現目盛り下限 = グラフ.Chart.Axes(xlValue).MinimumScale
        If Min目盛り下限 > 現目盛り下限 Then Min目盛り下限 = 現目盛り下限
        
    Next
    
    ' InputBoxでユーザーから目盛りの上限・下限設定を受け取る
    Dim 設定目盛り上限 As Double
    設定目盛り上限 = Application.InputBox( _
        "目盛りの上限値を設定して下さい。" & vbLf & _
        "※ 現在の目盛り上限最大値：" & Max目盛り上限 & vbLf & _
        "※ 現在の目盛り下限最小値：" & Min目盛り下限, "上限値の設定", Max目盛り上限, Type:=1)
    
    Dim 設定目盛り下限 As Double
    設定目盛り下限 = Application.InputBox( _
        "目盛りの下限値を設定して下さい。" & vbLf & _
        "※ 設定した目盛り上限値：" & 設定目盛り上限 & vbLf & _
        "※ 現在の目盛り下限最小値：" & Min目盛り下限, "下限値の設定", Min目盛り下限, Type:=1)
    
    If 設定目盛り上限 <= 設定目盛り下限 Then
        MsgBox "上限値が下限値を下回っています。": Exit Sub
    End If
    
    ' 設定された上限・下限から幅を計算して目盛間隔の推奨値を計算
    Dim 設定目盛り幅全体 As Double
    設定目盛り幅全体 = 設定目盛り上限 - 設定目盛り下限
    
    ' 目盛り幅全体の有効桁を取得（0.55→55、25000→25）
    Dim 目盛り幅の有効桁 As Double
    目盛り幅の有効桁 = 設定目盛り幅全体
    ' 小数を整数になるまで10倍
    Do
        If InStr(目盛り幅の有効桁, ".") > 0 Then
            目盛り幅の有効桁 = 目盛り幅の有効桁 * 10
        Else
            Exit Do
        End If
    Loop
    ' 1の位が0でなくなるまで10で割る
    Do
        If Right(目盛り幅の有効桁, 1) = 0 Then
            目盛り幅の有効桁 = 目盛り幅の有効桁 / 10
        Else
            Exit Do
        End If
    Loop
    
    ' 目盛り幅の有効桁の公約数を使って幅全体を割ることで推奨値を算定
    Dim 自動算定目盛り間隔 As Double
    If 目盛り幅の有効桁 Mod 4 = 0 Then
        自動算定目盛り間隔 = 設定目盛り幅全体 / 4
    ElseIf 目盛り幅の有効桁 Mod 5 = 0 Then
        自動算定目盛り間隔 = 設定目盛り幅全体 / 5
    ElseIf 目盛り幅の有効桁 Mod 3 = 0 Then
        自動算定目盛り間隔 = 設定目盛り幅全体 / 3
    ElseIf 目盛り幅の有効桁 Mod 8 = 0 Then
        自動算定目盛り間隔 = 設定目盛り幅全体 / 8
    ElseIf 目盛り幅の有効桁 Mod 6 = 0 Then
        自動算定目盛り間隔 = 設定目盛り幅全体 / 6
    Else
        自動算定目盛り間隔 = 設定目盛り幅全体 / 4
    End If
    
    ' 推奨値を初期値に設定目盛り幅をユーザーから取得
    Dim 設定目盛り間隔 As Double
    設定目盛り間隔 = Application.InputBox( _
        "目盛り間隔の値を設定して下さい。" & vbLf & _
        "※ 設定した目盛り上限値：" & 設定目盛り上限 & vbLf & _
        "※ 設定した目盛り下限値：" & 設定目盛り下限, "目盛り間隔の設定", 自動算定目盛り間隔, Type:=1)
    
    If 設定目盛り間隔 = 0 Then Exit Sub
    If 設定目盛り間隔 > 設定目盛り幅全体 Then
        MsgBox "目盛り幅がグラフ全体の幅を上回っています。": Exit Sub
    End If
    
    ' 設定値を元に各グラフの軸目盛りを設定
    For Each グラフ In Clct対象グラフリスト
        
        グラフ.Chart.Axes(xlValue).MaximumScale = 設定目盛り上限
        グラフ.Chart.Axes(xlValue).MinimumScale = 設定目盛り下限
        グラフ.Chart.Axes(xlValue).MajorUnit = 設定目盛り間隔

    Next
    
End Sub

解説

マクロのメインコードは非常に簡単で、

' 設定値を元に各グラフの軸目盛りを設定
For Each グラフ In Clct対象グラフリスト
    
    グラフ.Chart.Axes(xlValue).MaximumScale = 設定目盛り上限
    グラフ.Chart.Axes(xlValue).MinimumScale = 設定目盛り下限
    グラフ.Chart.Axes(xlValue).MajorUnit = 設定目盛り間隔

Next

このように各グラフの目盛上限・下限・間隔を設定して回っているだけです。

対象のグラフを取得する際に「選択したグラフ」を取ってくる必要があるため、
ChartObjectsやShapesをループすることができず、

Dim 図形オブジェクト
For Each 図形オブジェクト In Selection
    If 図形オブジェクト.ShapeRange.Type = msoChart Then
        
        Clct対象グラフリスト.Add ws対象シート.ChartObjects(図形オブジェクト.Name)
        
    End If
Next

このようにSelection(DrawingObjectsオブジェクト)をループして、
TypeがChartの図形をあたらめてChartObjectとして取得しています。

それ以外のコードはInputBoxの初期値にいい感じの値が入るよう、
目盛りの上限・下限・間隔をいい感じに計算しているだけです。

読まずに使っていただいて問題ありませんが、
興味がある方はコメントと共にコードを読んでみて下さい。