【ExcelVBA】複数選択またはすべてのグラフの数値軸を変更する方法

SHARE

こんなあなたにおすすめ

・Excel VBA 一つまたは複数のグラフの数値軸を変更したい

以下の2点ができるユーザーフォームを作成してみましたので、良ければお使いください。

  • 選択したグラフの数値軸を変更
  • 全てのグラフの数値軸を変更

以下よりダウンロード可能です。
>>ダウンロードはこちら。

コード

'===============================================================================================
'■Global変数定義
'===============================================================================================
Public xScale_min As Long
Public xScale_max As Long
Public xScale_interval As Long

Public yScale_min As Long
Public yScale_max As Long
Public yScale_interval As Long


'===============================================================================================
'■【キャンセル】ボタンクリックイベント
'===============================================================================================
Private Sub btnCancel_Click()
    Unload Me   'ユーザーフォームを閉じる
End Sub


'===============================================================================================
'■【OK】ボタンクリックイベント
'===============================================================================================
Private Sub btnOk_Click()

    '-----------------------------------------------------
    '◆テキストフォームから値を取得
    '-----------------------------------------------------
    xScale_min = Me.val_横軸_最小値.Value
    xScale_max = Me.val_横軸_最大値.Value
    xScale_interval = Me.val_横軸_目盛間隔.Value

    yScale_min = Me.val_縦軸_最小値.Value
    yScale_max = Me.val_縦軸_最大値.Value
    yScale_interval = Me.val_縦軸_目盛間隔.Value
    
    '-----------------------------------------------------
    '◆デバッグ
    '-----------------------------------------------------
'    Debug.Print xScale_min
'    Debug.Print xScale_max
'    Debug.Print xScale_interval
'    Debug.Print yScale_min
'    Debug.Print yScale_max
'    Debug.Print yScale_interval

    '-----------------------------------------------------
    '◆グラフスケール変更用のプロシージャを実行
    '-----------------------------------------------------
    If rbtn_選択グラフ = True Then
'        MsgBox "選択グラフ"

        changeSelectGraph_xScale
        changeSelectGraph_yScale
    Else
'        MsgBox "全てのグラフ"

        changeAllGraph_xScale  'x軸スケール変更用のプロシージャを実行
        changeAllGraph_yScale  'y軸スケール変更用のプロシージャを実行
    End If

    Unload Me   'ユーザーフォームを閉じる
    
End Sub


'===============================================================================================
'■数値入力のみ可能にする設定
'===============================================================================================
Private Sub val_横軸_最小値_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If Chr(KeyAscii)  "0" Or Chr(KeyAscii) > "9" Then
        KeyAscii = 0
    End If
End Sub

Private Sub val_横軸_最大値_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If Chr(KeyAscii)  "0" Or Chr(KeyAscii) > "9" Then
        KeyAscii = 0
    End If
End Sub

Private Sub val_横軸_目盛間隔_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If Chr(KeyAscii)  "0" Or Chr(KeyAscii) > "9" Then
        KeyAscii = 0
    End If
End Sub

Private Sub val_縦軸_最小値_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If Chr(KeyAscii)  "0" Or Chr(KeyAscii) > "9" Then
        KeyAscii = 0
    End If
End Sub

Private Sub val_縦軸_最大値_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If Chr(KeyAscii)  "0" Or Chr(KeyAscii) > "9" Then
        KeyAscii = 0
    End If
End Sub

Private Sub val_縦軸_目盛間隔_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If Chr(KeyAscii)  "0" Or Chr(KeyAscii) > "9" Then
        KeyAscii = 0
    End If
End Sub


'===============================================================================================
'■グラフのグラフのスケール変更 x軸 inputbox
'===============================================================================================
Sub changeAllGraph_xScale()

    Dim cht As ChartObject
    
    For Each cht In ActiveSheet.ChartObjects
        cht.Chart.Axes(xlCategory).MinimumScale = xScale_min    'x軸の最小値
        cht.Chart.Axes(xlCategory).MaximumScale = xScale_max    'x軸の最大値
        cht.Chart.Axes(xlCategory).MajorUnit = xScale_interval  'x軸の目盛間隔
    Next cht

End Sub


'===============================================================================================
'■全てのグラフのスケール変更 y軸
'===============================================================================================
Private Sub changeAllGraph_yScale()

    Dim cht As ChartObject

    For Each cht In ActiveSheet.ChartObjects
        cht.Chart.Axes(xlValue).MinimumScale = yScale_min   'y軸の最小値
        cht.Chart.Axes(xlValue).MaximumScale = yScale_max   'y軸の最大値
        cht.Chart.Axes(xlValue).MajorUnit = yScale_interval 'y軸の目盛間隔
    Next cht

End Sub


'===============================================================================================
'■選択したグラフのx軸スケールを変更
'===============================================================================================
Private Sub changeSelectGraph_xScale()
    
'    MsgBox VarType(Selection)

    Dim cht As ChartObject

    If TypeName(Selection) = "ChartArea" Then
'        MsgBox "グラフを選択しています。"
        With ActiveChart
            .Axes(xlCategory).MinimumScale = xScale_min   'x軸の最小値
            .Axes(xlCategory).MaximumScale = xScale_max   'x軸の最大値
            .Axes(xlCategory).MajorUnit = xScale_interval 'x軸の目盛間隔
        End With
    ElseIf TypeName(Selection) = "DrawingObjects" Then
'        MsgBox "グラフを複数選択しています。"
        For Each cht In Selection
'            MsgBox cht.Name
            cht.Chart.Axes(xlCategory).MinimumScale = xScale_min   'x軸の最小値
            cht.Chart.Axes(xlCategory).MaximumScale = xScale_max   'x軸の最大値
            cht.Chart.Axes(xlCategory).MajorUnit = xScale_interval 'x軸の目盛間隔
        Next cht
    Else
'        MsgBox "その他"
'        MsgBox "グラフが選択されていません。"
    End If
    
End Sub


'===============================================================================================
'■選択したグラフのy軸スケールを変更
'===============================================================================================
Private Sub changeSelectGraph_yScale()
    
'    MsgBox VarType(Selection)

    Dim cht As ChartObject

    If TypeName(Selection) = "ChartArea" Then
'        MsgBox "グラフを選択しています。"
        With ActiveChart
            .Axes(xlValue).MinimumScale = yScale_min   'y軸の最小値
            .Axes(xlValue).MaximumScale = yScale_max   'y軸の最大値
            .Axes(xlValue).MajorUnit = yScale_interval 'y軸の目盛間隔
        End With
    ElseIf TypeName(Selection) = "DrawingObjects" Then
'        MsgBox "グラフを複数選択しています。"
        For Each cht In Selection
'            MsgBox cht.Name
            cht.Chart.Axes(xlValue).MinimumScale = yScale_min   'y軸の最小値
            cht.Chart.Axes(xlValue).MaximumScale = yScale_max   'y軸の最大値
            cht.Chart.Axes(xlValue).MajorUnit = yScale_interval 'y軸の目盛間隔
        Next cht
    Else
'        MsgBox "その他"
        MsgBox "グラフが選択されていません。"
    End If
    
End Sub

【Excelの状態】

【ユーザーフォーム】

グラフを選択せずに「選択グラフ」にチェックを入れ、「OK」を押すと、以下のようにエラーになります。

まとめ

今回は、ユーザーフォームを使ってグラフを変更できるコードをご紹介しました。

ご自由にお使いください。

Excelで作業効率をアップしたい方は、下記の記事もご参照ください。
>>Excelのショートカット一覧 覚えて作業効率アップ!!
>>Excelで覚えておくべき関数 作業効率アップ間違いなし

【Excelについて学びたい方】
Excel 最強の教科書[完全版]
【Excel VBAについて学びたい方】
Excel VBA 脱初心者のための集中講座
エンジニアを目指すなら、TechAcademy！
オンラインスクール受講者数No.1！

・自宅にいながらオンライン完結で勉強できる
➡スクールへの移動時間を削減するため、効率的に学習可能！

・受講生に1人ずつ現役のプロのパーソナルメンターがつく
➡分からないことがわかるまで徹底的にメンターに質問可能！

・チャットで質問すればすぐに回答が返ってくる
➡レスポンスが速いから、わからないことをその場で解決！

・オリジナルサービスやオリジナルアプリなどの開発までサポート
➡就職、転職のときに役立つポートフォリオを開発可能！

無料で体験できるので、まずはお試し
>>TechAcademyの無料体験はこちら

コメントを残す

メールアドレスが公開されることはありません。 ※ が付いている欄は必須項目です

前の記事

【ExcelVBA】アクティブシートのグラフの数をカウントする…

次の記事

【ExcelVBA】特定の文字の位置を前から取得する方法