https://www.sejuku.net/blog/69474
https://amg-solution.jp/blog/29887
https://daitaideit.com/vba-graph-create-line/
https://daitaideit.com/vba-graph-change-sourcedata/
https://terakoya.sejuku.net/question/detail/34223
https://www.javadrive.jp/excelvba/chart/index4.html
https://www.relief.jp/docs/vba-clng-function-get-long-date.html
https://excel-ubara.com/excelvba1/EXCELVBA329.html
-- 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) = "データ1"
Cells(10, 4) = "データ2"
Cells(10, 5) = "データ3"
'セルヘッダ着色
Range("B10:E10").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))
Cells(i, 4).Value = CStr(Int(100 * Rnd))
Cells(i, 5).Value = CStr(Int(100 * Rnd))
Next i
'セル罫線設定
Range("B10:E20").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
'グラフにデータシリーズを追加
.SeriesCollection.NewSeries
.SeriesCollection.NewSeries
'X軸のデータを指定
.FullSeriesCollection(1).XValues = Range("B11:B20")
.FullSeriesCollection(2).XValues = Range("B11:B20")
'各データシリーズの範囲
.SeriesCollection(1).Values = Range("D11:D20")
.SeriesCollection(2).Values = Range("E11:E20")
'各データシリーズ名
.SeriesCollection(1).Name = "データ2"
.SeriesCollection(2).Name = "データ3"
'X軸の最大値と最小値
.Axes(xlCategory).MinimumScale = CLng(DateValue("2024/5/12"))
.Axes(xlCategory).MaximumScale = CLng(DateValue("2024/5/21"))
'凡例の表示
.HasLegend = True
'データ2の線を赤色へ変更
.FullSeriesCollection(1).Format.Line.ForeColor.RGB = RGB(255, 0, 0)
'データ3の線を青色へ変更
.FullSeriesCollection(2).Format.Line.ForeColor.RGB = RGB(0, 0, 255)
'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
'参照元データ変更
.FullSeriesCollection(1).XValues = Range("B11:B19")
.FullSeriesCollection(2).XValues = Range("B11:B19")
.SeriesCollection(1).Values = Range("D11:D19")
.SeriesCollection(2).Values = Range("E11:E19")
'X軸の最大値変更
.Axes(xlCategory).MaximumScale = CLng(DateValue("2024/5/20"))
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))
Cells(i, 4).Value = CStr(Int(100 * Rnd))
Cells(i, 5).Value = CStr(Int(100 * Rnd))
Next i
'セル罫線設定
Range("B10:E21").Borders.LineStyle = xlContinuous
With chartObj
With .Chart
'参照元データ変更
.FullSeriesCollection(1).XValues = Range("B11:B21")
.FullSeriesCollection(2).XValues = Range("B11:B21")
.SeriesCollection(1).Values = Range("D11:D21")
.SeriesCollection(2).Values = Range("E11:E21")
'X軸の最大値変更
.Axes(xlCategory).MaximumScale = CLng(DateValue("2024/5/22"))
End With
End With
'確認メッセージを表示する
Application.DisplayAlerts = True
'画面を更新する
Application.ScreenUpdating = True
End Sub
