【簡単エクセル/Excel VBA マクロ】グラフの作成｜Excelオブジェクトの操作 #003

your_folder/
　　├── グラフを作成する.xlsm（マクロ実行ファイル）
　　└── データ - A.xlsx（データ参照用ファイル）

Sub CreateGraph()


    ' 変数の宣言
    Dim file_path As String          ' 操作対象のExcelファイルのパスを格納する変数
    Dim wb As Workbook               ' 開いたワークブックを格納する変数
    Dim ws As Worksheet              ' 操作するワークシートを格納する変数
    Dim chart_object As ChartObject  ' 作成するグラフオブジェクトを格納する変数
    
    
    ' ファイルパスの設定
    file_path = ThisWorkbook.Path + "\データ - A.xlsx"
    
    
    ' ワークブックとワークシートのオープン
    Set wb = Workbooks.Open(file_path)
    Set ws = wb.Worksheets(1)
    
    
    ' グラフオブジェクトの作成
    Set chart_object = ws.ChartObjects.Add(200, 150, 400, 250)
    
    
    ' グラフの設定
    With chart_object.Chart
    
        ' ソースデータの設定
        .SetSourceData ws.Range(Cells(3, 2), Cells(4, 14))
    
        ' グラフスタイルの設定
        .ChartStyle = 201
    
        ' グラフタイトルの設定
        .ChartTitle.Text = ws.Cells(1, 2).Value
    
        ' Y軸の設定
        With .Axes(xlValue)
            .HasTitle = True
            .AxisTitle.Text = "数値"
        End With
    
        ' データラベルの設定
        With .SeriesCollection(1)
            .HasDataLabels = True
            .DataLabels.Orientation = xlUpward
        End With
    
    End With
    
    
    ' グラフの更新
    chart_object.Chart.Refresh
    
    
    ' ワークブックを保存して閉じる
    wb.Close savechanges:=True


End Sub

    ' 変数の宣言
    Dim file_path As String          ' 操作対象のExcelファイルのパスを格納する変数
    Dim wb As Workbook               ' 開いたワークブックを格納する変数
    Dim ws As Worksheet              ' 操作するワークシートを格納する変数
    Dim chart_object As ChartObject  ' 作成するグラフオブジェクトを格納する変数

    ' ファイルパスの設定
    file_path = ThisWorkbook.Path + "\データ - A.xlsx"

    ' ワークブックとワークシートのオープン
    Set wb = Workbooks.Open(file_path)
    Set ws = wb.Worksheets(1)

    ' グラフオブジェクトの作成
    Set chart_object = ws.ChartObjects.Add(200, 150, 400, 250)

    ' グラフの設定
    With chart_object.Chart
    
        ' ソースデータの設定
        .SetSourceData ws.Range(Cells(3, 2), Cells(4, 14))
    
        ' グラフスタイルの設定
        .ChartStyle = 201
    
        ' グラフタイトルの設定
        .ChartTitle.Text = ws.Cells(1, 2).Value
    
        ' Y軸の設定
        With .Axes(xlValue)
            .HasTitle = True
            .AxisTitle.Text = "数値"
        End With
    
        ' データラベルの設定
        With .SeriesCollection(1)
            .HasDataLabels = True
            .DataLabels.Orientation = xlUpward
        End With
    
    End With

    ' グラフの更新
    chart_object.Chart.Refresh

    ' ワークブックを保存して閉じる
    wb.Close savechanges:=True

Sub CreateChartsToMultipleFiles()


    ' 変数の宣言
    Dim file_path As String          ' ファイルのディレクトリパスを格納する変数
    Dim file_name As String          ' 操作対象のExcelファイル名を格納する変数
    Dim wb As Workbook               ' 開いたワークブックを格納する変数
    Dim ws As Worksheet              ' 操作するワークシートを格納する変数
    Dim chart_object As ChartObject  ' 作成するグラフオブジェクトを格納する変数


    ' ディレクトリパスの設定
    file_path = ThisWorkbook.Path & "\data\"


    ' ディレクトリ内の最初のファイルを取得
    file_name = Dir(file_path & "*.xlsx")


    ' ファイルが存在する限りループ
    Do While file_name <> ""
    
        ' ワークブックとワークシートのオープン
        Set wb = Workbooks.Open(file_path & file_name)
        Set ws = wb.Worksheets(1)
        
        ' グラフオブジェクトの作成
        Set chart_object = ws.ChartObjects.Add(200, 150, 400, 250)
        
        ' グラフの設定
        With chart_object.Chart
        
            ' ソースデータの設定
            .SetSourceData ws.Range(Cells(3, 2), Cells(4, 14))
        
            ' グラフスタイルの設定
            .ChartStyle = 201
        
            ' グラフタイトルの設定
            .ChartTitle.Text = ws.Cells(1, 2).Value
        
            ' Y軸の設定
            With .Axes(xlValue)
                .HasTitle = True
                .AxisTitle.Text = "数値"
            End With
        
            ' データラベルの設定
            With .SeriesCollection(1)
                .HasDataLabels = True
                .DataLabels.Orientation = xlUpward
            End With
        
        End With
        
        ' グラフの更新
        chart_object.Chart.Refresh

        ' オブジェクトの解放
        Set chart_object = Nothing
        
        ' ワークブックを保存して閉じる
        wb.Close savechanges:=True
        
        ' 次のファイルを取得
        file_name = Dir()
    
    Loop


End Sub