はじめに

マクロを使い、エクセルファイル内にある複数の同じ形式のグラフの書式や大きさを統一する方法について考えたい。

マクロ作成の経緯

複数の同じ形式のグラフの書式や大きさを調整する際に、1つ変更すれば、他のグラフにも、その変更を適用できたらと考えたのがきっかけだった。

作成したマクロの概要

エクセルのグラフテンプレート機能を使い、選択したグラフのテンプレートファイルを一時的に作成し、他の同じ形式のグラフに適用する。

動作手順

グラフが選択されているか確認
選択されているグラフの幅・高さ・グラフの種類を取得
選択されているグラフのテンプレートを保存
書式・大きさを適用するかどうかのメッセージを表示
各シートのグラフに対して、同じグラフの種類かどうかを確認
同じグラフの種類の場合、テンプレートを適用し、大きさを調整する
保存したグラフのテンプレートを削除

注意点

Chart.ChartTypeプロパティで返されるグラフの種類(XlChartType)で同じ形式か判断するため、見た目は同じでも、違うグラフの場合がある

完成したマクロ

ApplySameFormatCharts

Public Sub ApplySameFormatCharts()

Dim TemplateChartObject As ChartObject
Dim TemplateChartName As String
Dim TemplateChartWidth As Double
Dim TemplateChartHeight As Double
Dim TemplateChartType As XlChartType
Dim Rtn_Size As Long
Dim Rtn_Temp As Long
Dim TargetSheet As Worksheet
Dim TargetChartObject As ChartObject

    If ActiveChart Is Nothing Then   
        MsgBox "グラフが選択されていません。グラフを選択してから実行してください。"
        Exit Sub
    End If
    
    Set TemplateChartObject = ActiveChart.Parent
    
    TemplateChartWidth = TemplateChartObject.Width
    TemplateChartHeight = TemplateChartObject.Height
    TemplateChartType = TemplateChartObject.Chart.ChartType
    
    TemplateChartName = ThisWorkbook.Path & "\グラフテンプレート" & Format(Now, "yymmdd_hhmmss")
    TemplateChartObject.Chart.SaveChartTemplate TemplateChartName

    Rtn_Temp = MsgBox("選択中のグラフの書式を適用しますか？", vbYesNo + vbQuestion)
    Rtn_Size = MsgBox("選択中のグラフの大きさを適用しますか？", vbYesNo + vbQuestion)
    
     For Each TargetSheet In ActiveWorkbook.Sheets 
        For Each TargetChartObject In TargetSheet.ChartObjects
            If TargetChartObject.Chart.ChartType = TemplateChartType Then
                
                If Rtn_Temp = vbYes Then 
                    TargetChartObject.Chart.ApplyChartTemplate (TemplateChartName)
                End If
                
                If Rtn_Size = vbYes Then
                    TargetChartObject.Width = TemplateChartWidth
                    TargetChartObject.Height = TemplateChartHeight
                End If
                
            End If
        Next TargetChartObject
    Next TargetSheet
    
    Kill TemplateChartName & ".crtx"
    
End Sub

サンプルファイル：