VBA(グラフの軸と参照セル範囲の変更 1系列)

http://officetanaka.net/excel/vba/tips/tips150.htm
https://amg-solution.jp/blog/29887

-- 1. 開発タブの挿入でボタンを作成
※ActiveXコントロールのものを使用する

-- 2. デザインモードONで作成したボタンをダブルクリックするとエディタが開くので下記コードを記載。デザインモードOFFで実行

Option Explicit

Private Sub CommandButton1_Click()

    
    '画面を更新しない
    Application.ScreenUpdating = False
    '確認メッセージを表示しない
    Application.DisplayAlerts = False
    
    
    'テスト用データ作成
    '10行目以下をクリア
    Dim LastRow As Long
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Rows("10:" & LastRow).Delete
    
    
    Cells(10, 2) = "日付"
    Cells(10, 3) = "val1"
    
    'セルヘッダ着色
    Range("B10:C10").Interior.Color = RGB(189, 249, 253)
    
    Dim i As Long
    
    For i = 11 To 20
        Cells(i, 2).Value = CDate("2024/05/01") + i
        Cells(i, 3).Value = CStr(Int(100 * Rnd))
    Next i
    
    'セル罫線設定
    Range("B10:C20").Borders.LineStyle = xlContinuous
    

    
    '既存のグラフ削除
    With ActiveSheet
        For i = .ChartObjects.Count To 1 Step -1
            .ChartObjects(i).Delete
        Next i
    End With
    
    
    'グラフの作成
    With ActiveSheet.Shapes.AddChart
    
        'グラフ表示位置とサイズの設定
        .Top = Range("G3").Top
        .Left = Range("G3").Left
        .Width = 300
        .Height = 200
        
        
        With .Chart
        
            '折れ線グラフを指定
            .ChartType = xlLine
            
            'グラフ範囲を指定
            .SetSourceData Cells(10, "C").CurrentRegion
            
            
            
            'X軸の最大値と最小値
            .Axes(xlCategory).MinimumScale = CLng(DateValue("2024/5/12"))
            .Axes(xlCategory).MaximumScale = CLng(DateValue("2024/5/21"))
            
           
Debug.Print ".Axes(xlCategory).MaximumScale", .Axes(xlCategory).MaximumScale
Debug.Print ".SeriesCollection(1).Formula", .SeriesCollection(1).Formula

            '凡例の表示
            .HasLegend = True

            'X軸の表示形式を指定
            .Axes(xlCategory).TickLabels.NumberFormatLocal = "yyyy-mm-dd"

            'タイトルの表示
            .HasTitle = True
            'タイトルの指定
            .ChartTitle.Text = "グラフタイトル"

            With .ChartTitle.Format.TextFrame2.TextRange.Font
                'タイトルサイズ
                .Size = 15
                'タイトル細字
                .Bold = False
            End With
            
        End With
    
    End With
        
    
    'グラフオブジェクトをオブジェクト変数に格納
    Dim chartObj As Variant
    Set chartObj = ActiveSheet.ChartObjects(1)

    'データ削除

    Range("B20").EntireRow.Delete

    With chartObj
        With .Chart

            
            'グラフ範囲を指定
            .SetSourceData Cells(10, "C").CurrentRegion
            'X軸の最大値変更
            .Axes(xlCategory).MaximumScale = CLng(DateValue("2024/5/20"))

Debug.Print ".Axes(xlCategory).MaximumScale", .Axes(xlCategory).MaximumScale
Debug.Print ".SeriesCollection(1).Formula", .SeriesCollection(1).Formula

        End With
    End With

    'データ追加

    Range("B20").EntireRow.Insert
    Range("B21").EntireRow.Insert

    For i = 20 To 21
        Cells(i, 2).Value = CDate("2024/05/01") + i
        Cells(i, 3).Value = CStr(Int(100 * Rnd))

    Next i

    'セル罫線設定
    Range("B10:C21").Borders.LineStyle = xlContinuous

    With chartObj

        With .Chart
        
            
            'グラフ範囲を指定
            .SetSourceData Cells(10, "C").CurrentRegion
            'X軸の最大値変更
            .Axes(xlCategory).MaximumScale = CLng(DateValue("2024/5/22"))

Debug.Print ".Axes(xlCategory).MaximumScale", .Axes(xlCategory).MaximumScale
Debug.Print ".SeriesCollection(1).Formula", .SeriesCollection(1).Formula

'凡例の値取得

Dim f1 As String
f1 = .SeriesCollection(1).Formula
Debug.Print "f1=", f1

Dim f2 As String
f2 = Replace(f1, "!", ",")

Dim f3 As Variant
f3 = Split(f2, ",")(1)

Debug.Print "f3=", f3
Debug.Print "凡例の値=", Range(f3).Value

        End With
    End With

    
    '確認メッセージを表示する
    Application.DisplayAlerts = True
    '画面を更新する
    Application.ScreenUpdating = True

End Sub