'埋め込みグラフのプロットエリアの位置とサイズを統一するマクロ（Excel95）

'基準とするオブジェクトを選択し、MyFormatPlotAreaマクロを実行してください。

Option Explicit

'グラフオブジェクト用のRect構造体
'グラフ内は左下が基準なのでTopではなくBottomを格納します
Type TChartRect
    Left As Double
    Bottom As Double
    Width As Double
    Height As Double
End Type

'グラフオブジェクトのLeftを取得する関数
Function GetChartLeft() As Double
    GetChartLeft = Application.ExecuteExcel4Macro("GET.CHART.ITEM(1,1)")
End Function

'グラフオブジェクトのTopを取得する関数
Function GetChartTop() As Double
    GetChartTop = Application.ExecuteExcel4Macro("GET.CHART.ITEM(2,1)")
End Function

'グラフオブジェクトのRightを取得する関数
Function GetChartRight() As Double
    GetChartRight = Application.ExecuteExcel4Macro("GET.CHART.ITEM(1,5)")
End Function

'グラフオブジェクトのBottomを取得する関数
Function GetChartBottom() As Double
    GetChartBottom = Application.ExecuteExcel4Macro("GET.CHART.ITEM(2,5)")
End Function

'グラフオブジェクトの位置とサイズを取得する関数
'FORMAT.MOVE()とFORMAT.SIZE()で指定可能な値を返します
Function GetChartRect(chartRect As TChartRect)
    chartRect.Left = GetChartLeft() - 1
    chartRect.Bottom = GetChartBottom() - 1
    chartRect.Width = GetChartRight() - chartRect.Left - 1
    chartRect.Height = GetChartTop() - chartRect.Bottom - 1
End Function

'グラフオブジェクトの位置とサイズを設定する関数
Function FormatMoveSize(chartRect As TChartRect)
    Application.ExecuteExcel4Macro _
        "FORMAT.MOVE(" & chartRect.Left & "," & chartRect.Bottom & ")"
    Application.ExecuteExcel4Macro _
        "FORMAT.SIZE(" & chartRect.Width & "," & chartRect.Height & ")"
End Function


'埋め込みグラフのプロットエリアの位置とサイズを統一するマクロ
Sub MyFormatPlotArea()
    Dim ChartObjectRect As TChartRect
    Dim PlotAreaRect As TChartRect
    Dim TitleRect As TChartRect
    Dim LegendRect As TChartRect
    Dim bHasTitle As Boolean
    Dim bHasLegend As Boolean
    Dim AxesRect(1 To 3, 1 To 2) As TChartRect
    Dim bHasAxesTitle(1 To 3, 1 To 2) As Boolean
    Dim AxesConst1(1 To 3) As Long
    Dim AxesConst2(1 To 2) As Long
    Dim iChartIndex As Integer, iCount As Integer
    Dim i As Long, j As Long
    Dim obj As Object
    Dim iRepeatCount As Integer

    AxesConst1(1) = xlValue
    AxesConst1(2) = xlCategory
    AxesConst1(3) = xlSeries
    AxesConst2(1) = xlPrimary
    AxesConst2(2) = xlSecondary

    '位置とサイズの設定の反復回数
    iRepeatCount = 3

    '選択オブジェクトのチェック
    If TypeName(Selection) <> "ChartObject" Then
        MsgBox "埋め込みグラフを選択して実行してください。", vbExclamation
        Exit Sub
    End If

    '確認
    If MsgBox("シート上のすべてのグラフのプロットの位置とサイズを、" & _
        Chr$(10) & "選択オブジェクトと同一にします。", _
        vbOKCancel Or vbExclamation) <> vbOK Then Exit Sub

    Application.ScreenUpdating = False

    With Selection

        '基準とするオブジェクトのIndexを1にする
        .SendToBack

        'ChartObjectの位置とサイズを取得
        ChartObjectRect.Width = Selection.Width
        ChartObjectRect.Height = Selection.Height
        ChartObjectRect.Left = Selection.Left
        ChartObjectRect.Bottom = Selection.Top

        'グラフをアクティブにする
        .Activate

        'PlotAreaの位置とサイズを取得
        ActiveChart.PlotArea.Select
        GetChartRect PlotAreaRect

        'ChartTitleの位置とサイズを取得
        If ActiveChart.HasTitle Then
            bHasTitle = True
            ActiveChart.ChartTitle.Select
            GetChartRect TitleRect
        End If

        'Legendの位置とサイズを取得
        If ActiveChart.HasLegend Then
            bHasLegend = True
            ActiveChart.Legend.Select
            GetChartRect LegendRect
        End If

        'AxesTitleの位置とサイズを取得
        For i = 1 To 3
            For j = 1 To 2
                Set obj = GetAxes(ActiveChart, AxesConst1(i), AxesConst2(j))
                If Not (obj Is Nothing) Then
                    If obj.HasTitle Then
                        bHasAxesTitle(i, j) = True
                        obj.AxisTitle.Select
                        GetChartRect AxesRect(i, j)
                    End If
                End If
            Next
        Next

        'グラフウィンドウを閉じる
        ActiveWindow.Visible = False
    End With

    'シート上のChartObjectに対して繰り返す
    For iChartIndex = 2 To ActiveSheet.ChartObjects.Count

        'ChartObjectの位置とサイズの設定
        ActiveSheet.ChartObjects(iChartIndex).Select
        With Selection
            .Width = ChartObjectRect.Width
            .Height = ChartObjectRect.Height
            '.Left = ChartObjectRect.Left
            '.Top = ChartObjectRect.Bottom
            .Activate
        End With

        '同じ設定を複数回繰り返す
        For iCount = 1 To iRepeatCount

            'PlotAreaの位置とサイズの設定
            ActiveChart.PlotArea.Select
            FormatMoveSize PlotAreaRect

            'ChartTitleの位置とサイズの設定
            ActiveChart.HasTitle = bHasTitle
            If bHasTitle Then
                ActiveChart.ChartTitle.Select
                FormatMoveSize TitleRect
            End If

            'Legendの位置とサイズの設定
            ActiveChart.HasLegend = bHasLegend
            If bHasLegend Then
                ActiveChart.Legend.Select
                FormatMoveSize LegendRect
            End If

            'AxesTitleの位置とサイズの設定
            For i = 1 To 3
                For j = 1 To 2
                    Set obj = GetAxes(ActiveChart, AxesConst1(i), AxesConst2(j))
                    If Not (obj Is Nothing) Then
                        obj.HasTitle = bHasAxesTitle(i, j)
                        If bHasAxesTitle(i, j) Then
                            obj.AxisTitle.Select
                            FormatMoveSize AxesRect(i, j)
                        End If
                    End If
                Next
            Next
        Next

        'グラフウィンドウを閉じる
        ActiveWindow.Visible = False
    Next
End Sub

'Axes（軸）オブジェクトを取得する関数
Function GetAxes(chart1 As Object, index1 As Long, index2 As Long) As Object
    On Error Resume Next
    Set GetAxes = Nothing
    Set GetAxes = chart1.Axes(index1, index2)
End Function