← コード一覧へ戻る
実務グラフ

練習シート内のグラフの幅と高さを揃える

大きさの異なる3個のグラフを、先頭グラフの幅420pt・高さ250ptに揃えます。

実行前に確認

  • 既存のシートやグラフを変更しない練習例です。「VBAグラフ5009」が既にある場合は中止します。再実行は新しい練習ブックで行うか、作成済みの練習シートを自分で別名にしてから行ってください。
  • この例は公式API仕様を参照して作成しています。Excel実機での動作確認は行っていません。エラー時に作成途中の練習シートが残る場合があります。
  • 幅と高さを別々に指定するため、練習用グラフの縦横比固定を解除しています。実務ではレイアウトが崩れないか確認してください。

1サンプルコード

Option Explicit

Sub Example5009()
    Dim ws As Worksheet, co As ChartObject
    Dim extra As ChartObject, target As ChartObject
    Dim n As Long
    On Error GoTo Failed
    '新しい練習シートだけを作成・変更します。
    Set ws = NewSheet5009()
    If ws Is Nothing Then Exit Sub
    Set co = ws.ChartObjects.Add(ws.Range("E2").Left, ws.Range("E2").Top, 420, 250)
    co.ShapeRange.Item(1).Name = "練習グラフ"
    co.Chart.ChartType = xlColumnClustered
    co.Chart.SetSourceData Source:=ws.Range("A1:C5"), PlotBy:=xlColumns
    'ここから今回の操作です。
    For n = 2 To 3
        Set extra = ws.ChartObjects.Add( _
            co.Left, co.Top + (n - 1) * 280, 300 + n * 40, 150 + n * 20)
        extra.Chart.ChartType = xlColumnClustered
        extra.Chart.SetSourceData ws.Range("A1:C5"), xlColumns
    Next n
    For Each target In ws.ChartObjects
        target.ShapeRange.LockAspectRatio = msoFalse
        target.Width = co.Width
        target.Height = co.Height
    Next target
    MsgBox "3個のグラフを幅420pt・高さ250ptに揃えました。"
    Exit Sub
Failed:
    MsgBox "処理を中止しました: " & Err.Description, vbExclamation
End Sub

Private Function NewSheet5009() As Worksheet
    Const SHEET_NAME As String = "VBAグラフ5009"
    Dim item As Object, ws As Worksheet
    Dim data As Variant, r As Long, c As Long
    '同名シートがあれば、上書きせずに終了します。
    For Each item In ThisWorkbook.Sheets
        If StrComp(item.Name, SHEET_NAME, vbTextCompare) = 0 Then
            MsgBox SHEET_NAME & " は既にあります。別の練習ブックで試してください。"
            Exit Function
        End If
    Next item
    Set ws = ThisWorkbook.Worksheets.Add( _
        After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = SHEET_NAME
    data = Array(Array("月", "売上", "計画"), _
                 Array("4月", 120, 100), Array("5月", 160, 140), _
                 Array("6月", 110, 150), Array("7月", 180, 170))
    For r = 0 To UBound(data)
        For c = 0 To UBound(data(r))
            ws.Cells(r + 1, c + 1).Value = data(r)(c)
        Next c
    Next r
    ws.Range("A1:C5").Columns.AutoFit
    Set NewSheet5009 = ws
End Function

図で見る幅と高さを同じにする

イメージ図

大きさの違う3個のグラフを最初のグラフに合わせます。

  1. 寸法の違う3個

    420×250ptのグラフと、別サイズの2個を作る。

  2. 比率固定を解除

    LockAspectRatio=msoFalseにする。

  3. 寸法をコピー

    各グラフのWidth・Heightをcoと同じにする。

新しい練習シートの3個だけが対象です。位置はサイズ統一の処理では変更しません。

コードの処理を説明する模式図です。実際の画面や実行結果を撮影したものではありません。

使い方・実行手順を確認する4つの手順で、コードの使い方を確認できます
  1. 1

    Windows版デスクトップExcelで空の練習ブックを作り、Excelマクロ有効ブック(.xlsm)として保存します。Web版ExcelではVBAを実行できません。

  2. 2

    Alt+F11でVBEを開き、[挿入]→[標準モジュール]を選びます。Option Explicitから末尾のEnd Functionまで、この例のコード全体を空の標準モジュールへ貼り付けます。

  3. 3

    Example5009のSub内にカーソルを置いてF5キーを押します。コードを入れたブックに「VBAグラフ5009」シート、A1:C5のサンプル表、埋め込みグラフ「練習グラフ」を自動作成します。別のガイドの実行は不要です。

  4. 4

    下へスクロールし、縦に並んだ3個のグラフが同じ幅・高さになっていることを確認します。

使っている機能の公式ドキュメント(Microsoft Learn)