csvファイルを読み込んでグラフまで作成するマクロ（メモ）

仕事ではcsvファイルに出力されたデータを同じような出力でまとめる必要がある場合がある。そのときにマクロが便利なのだが、グラフ領域を引き渡したらグラフを作ってくれるものができないかと考えていた。

調べると。Workbooks().sheets().ChartObject.Add()という方法でグラフのオブジェクトを作成してパラメータを設定していくような方法ができるらしいのでその方法で作ってみた。ChartObjectへの値設定のための引数が膨大になるので、GraphParamというものを作って、そこにいろいろな変数を放り込んでおいてグラフ作成サブルーチンを使うという方法をとった。

とりあえず仕事では使い物になっている程度のものはできているが、改造のために家でも同じようなものを作っておく。一部使わなくなったパラメータがあるがご愛嬌。

Option Explicit
Private Type GraphParam
    BookName As String 'グラフ作成対象のブック
    SheetIndex As Integer 'グラフ作成対象のワークシート番号
    SheetName As String 'グラフ作成対象のシート名
    DataStartRow As Long 'データ開始行番号
    TitleRow As Long 'データの凡例？に表示される名前のある行番号
    xPosition As Double 'グラフ左上の出力先x座標
    yPosition As Double '同y座標
    xDataCol As Long 'xy散布図を作るときのxデータの列番号
    yDataStartCol As Long '同yデータ開始列番号（複数データを許容する）
    yDataCount As Long 'yデータの個数（x, y1, y2,,, ynというように複数のデータを持つ散布図が作成できるようにしておく）
    Width As Double 'グラフの幅
    Height As Double 'グラフの高さ
    PlotAreaWidth As Double '多分使わない？
    PlotAreaLeft As Double '同上
End Type

---

Private Sub CommandButton1_Click()
Dim FileName As String
Dim Fn As Integer
Dim param1 As Double
Dim param2 As Double
Dim i As Long
Dim gp As GraphParam

FileName = Application.GetOpenFilename("csv file, *.csv", , "select a csv file", , False)
If FileName = "False" Then Exit Sub

Workbooks.Add
Fn = FreeFile
i = 1
With ActiveWorkbook.ActiveSheet
    .Cells(i, 2) = "param1"
    .Cells(i, 3) = "param2"
    i = i + 1
    Open FileName For Input As #Fn
        Do Until EOF(Fn)
            Input #Fn, param1, param2
            .Cells(i, 2) = param1
            .Cells(i, 3) = param2
            i = i + 1
        Loop
    Close #Fn
   
End With

gp.BookName = ActiveWorkbook.Name
gp.SheetIndex = ActiveSheet.Index

gp.TitleRow = 1
gp.xDataCol = 2
gp.yDataStartCol = 3
gp.yDataCount = 1

gp.DataStartRow = 2

gp.xPosition = 30
gp.yPosition = 30
gp.Width = 300
gp.Height = 200

Call CreatGraph(gp)
End Sub

---

Private Sub CreatGraph(GraphParameter As GraphParam)
Dim oGraph As ChartObject
Dim lRows As Long
Dim i As Long
Dim NameOfSheet As String
Dim DataRangeX As String
Dim DataRangeY() As String
Dim DataRangeName() As String
Dim DataRangeCol As Integer

With GraphParameter
    Set oGraph = Workbooks(.BookName).Sheets(.SheetIndex).ChartObjects.Add(.xPosition, .yPosition, .Width, .Height)
    DataRangeCol = .xDataCol
    lRows = Workbooks(.BookName).Sheets(.SheetIndex).Cells(.DataStartRow, .yDataStartCol).End(xlDown).Row
    NameOfSheet = Trim(Workbooks(.BookName).Sheets(.SheetIndex).Name)
    DataRangeX = "=" & NameOfSheet & "!R" & Trim(Str(.DataStartRow)) & "C" & Trim(Str(DataRangeCol)) & ":R" & Trim(Str(lRows)) & "C" & Trim(Str(DataRangeCol))
    
    ReDim Preserve DataRangeY(.yDataCount)
    ReDim Preserve DataRangeName(.yDataCount)
    
    For i = 1 To .yDataCount
        DataRangeCol = .yDataStartCol + i - 1
        DataRangeY(i) = "=" & NameOfSheet & "!R" & Trim(Str(.DataStartRow)) & "C" & Trim(Str(DataRangeCol)) & ":R" & Trim(Str(lRows)) & "C" & Trim(Str(DataRangeCol))
        DataRangeName(i) = "=" & NameOfSheet & "!R" & Trim(Str(.TitleRow)) & "C" & Trim(Str(DataRangeCol))
    Next i
End With

With oGraph.Chart

    For i = 1 To GraphParameter.yDataCount
        .SeriesCollection.NewSeries
        With .SeriesCollection(i)
            .ChartType = xlXYScatterLinesNoMarkers
            .XValues = DataRangeX
            .Values = DataRangeY(i)
            .Name = DataRangeName(i)
            
            
        End With
    Next i

End With
Set oGraph = Nothing

End Sub