マクロ作成

 いよいよ本番です。
 これから、入力されたデータをもとにチャートを描画するマクロの作成を行います。

 まず、チャート描画で行わなければならない操作手順は

  1. 日付等描画に必要な情報の収集
  2. 表示中のチャートを消去
  3. 分類ごとに項目データを取得
  4. チャートの描画

となります。手順がわかればそのままその手順を実行するマクロを作成するだけですが、やはりここでもある程度の取り決めを先に考えておくことが重要な鍵となります。そこで、ここでは以下の順番でマクロ作成を行うことにします。

  1. グローバル変数の設定
  2. チャート消去プロシージャー作成
  3. 項目データ取得プロシージャー作成
  4. チャート描画プロシージャー作成

それではVisual Basic Editor(以下VBE)を起動し、マクロの作成に入りましょう。

グローバル変数の設定

グローバル変数とローカル変数

これは変数の宣言位置により、変数の参照できる範囲が異なるため区別されているものです。

グローバル変数 : プロシージャやファンクションの枠外で宣言され、モジュール内で一意に使用できる変数です。 各プロシージャで共通に使用する変数やデータの受け渡しに便利。
ローカル変数 : プロシージャやファンクション内で宣言され、その宣言された枠内でのみ使用できる変数です。プロシージャやファンクションの実行が終了すると内容が消去されます。また、グローバル変数と同名の変数は定義しないほうが良いでしょう。

 グローバル変数の設定として、共通して使用することがわかっている値や名称などをSubやFunctionの枠外で定義することでマクロの作成が容易になります。これは経験と勘で色々な作り方があるので、どうしたらいいとは一概に言えません。あまりに多くのグローバル変数を定義するとマクロの汎用性が失われるし、メモリーも多く消費することになります。かといって、まったくグローバル変数を定義しないと結構マクロ作りが大変になります。ということで、ここで示す例はあくまで僕の方法であり、それぞれに良い方法があればそれを検討し、使用してもかまいません。

ではグローバル変数として定義しておいたほうが良いと思われるものを列挙します。

  1. チャートの行数
  2. チャート開始行
  3. チャート開始列
  4. 先頭の日付
  5. チャート日数
  6. チャート用オートシェイプの名称

それでは、VBEでモジュールの追加を行い、その先頭から以下の構文を入力してください。

'変数定義
Dim CHART_ROWS As Integer 'チャートの行数
Dim CHART_ROW As Integer  'チャート開始行
Dim CHART_COL As Integer  'チャート開始列
Dim CHART_DATE As Date    '開始日
Dim CHART_DAYS As Integer '日数
Dim CHART_NAME As String  'チャート名称
次にこれら変数を定義するSubプロシージャーを作成します。
'それぞれの変数に初期値を与える
Sub 変数初期化()
 
    CHART_ROWS = 30   '30行に設定
    CHART_ROW = 5     'チャートの開始行
    CHART_COL = 5     'チャートの開始列
    CHART_DATE = Sheet3.Cells(3, 5).Value
                      'セルのE3の値
    CHART_DAYS = 31   '31日間
    CHART_NAME = "CHART"  'CHARTという名前で作成
 
End Sub

チャート消去プロシージャーの作成

 このプロシージャーでは既に描画されているチャートを消去し、新しいチャートを描画する準備を行います。
その手順として、

  1. 名前が変数「CHART_NAME」と等しいオートシェイプを消去(For Each文にてオートシェイプを検索)
  2. 分類、項目、担当者の内容を消去(範囲を指定してClearContentsを使用)

とします。

'表示されているチャートの消去
Sub チャート消去()
 
Dim s As Shape
 
    '表示中のシートにあるオートシェイプの中から
    'CHART_NAMEと等しい名前のものを消去する。
    For Each s In ActiveSheet.Shapes
        If s.Name = CHART_NAME Then s.Delete
    Next s
    '分類、項目、担当者の消去
    Range(Cells(CHART_ROW, 1), _
        Cells(CHART_ROW + CHART_ROWS - 1, 4)).ClearContents

End Sub

 試しにシートに直線なり四角なりの図形を描画して、このプロシージャーを実行してみてください。
どうです、消えましたか?ただ描画しただけでは消えないはずです。

 次に図形の名前を「CHART」に設定してみてください。そして「チャート消去」を再び実行すると、描画したオートシェイプが消えるはずです。この際、エラーで終了する人がほとんどだと思います。その場合は、「変数初期化」を先に実行してから「チャート消去」を実行してみてください。

 また、分類や項目、担当者の列に記入した文字列も一緒に消去されることを確認してください。

項目データ取得プロシージャー作成

 まず、プログラムがどのうような流れで項目データを取得するのかを見てみましょう。

繰り返し 分類番号の取得
繰り返し 分類番号と等しい項目の検索
予定、実績の開始終了日時がチャート期間中にあるか
項目名の複写
チャートの描画
次の分類へ移動、次の分類がなければ終了

わかりにくいかもしれないですが、これをプロシージャーで書くと

'項目データ取得
Sub 項目データ取得()
 
Dim I As Integer
Dim J As Integer
 
    I = 2
    '分類の数だけ繰り返す
    Do
        '分類がなくなれば終了
        If Sheet1.Cells(I, 1).Value = "" Then Exit Do
        
        J = 2
        '項目の数だけ繰り返す
        Do
            '項目がなくなれば終了
            If Sheet2.Cells(J, 1).Value = "" Then Exit Do
        
            '分類番号が等しいか否かの確認
            '日時確認処理
            'チャート描画処理
            J = J + 1
        Loop
        I = I + 1
    Loop

End Sub

となります。

 ここからIf文の応酬です。分類番号が等しいかを確認して、等しければ日時がチャートの期間内にあるかを確認して、期間内であればチャートを描画する。このような分岐処理をどんどん書き込んでいくのも良いのですが、せっかくVBAでは関数の使用が可能なので、その機能を利用することにします。

 どういうことかというと、決まった処理はFunctionプロシージャーを作ってそこで処理を行い、結果のみを返してもらうのです。具体的なFunctionプロシージャーを示します。

'分類番号が等しいか否かの確認
Function 分類番号の確認(分類 As Integer, 項目 As Integer) As Boolean
 
    '分類番号が項目の分類番号と等しい場合はTrueを、
    'そうでない場合はFalseを返す
    If 分類 = Sheet2.Cells(項目, 4).Value Then
        分類番号の確認 = True
    Else
        分類番号の確認 = False
    End If
 
End Function

 これは分類と項目の番号を入力すると、その項目の分類番号が入力した分類と等しいか否かの確認を行います。等しい場合は「True」を、等しくない場合は「False」を返します。
 次に日付の確認をするFunctionプロシージャーは次のようになります。

'日時確認処理
Function 日時確認(項目 As Integer) As Boolean
 
Dim I As Integer
Dim DT As Integer  'チャート描画日数
 
    日時確認 = False
    DT = CHART_DAYS

    With Sheet2
        '期間内か否かの確認
        For I = 5 To 8
            '予定、実績の開始、終了日時がチャート期間内の場合
            If .Cells(項目, I).Value > CHART_DATE And _
                .Cells(項目, I).Value < CHART_DATE + DT Then _
                日時確認 = True
        Next I
        '期間内にないが期間をはさむ場合
        If 日時確認 = False Then
            '予定の開始、終了日時がチャート期間をはさむ場合
            If .Cells(項目, 5).Value < CHART_DATE And _
                .Cells(項目, 6).Value > CHART_DATE + DT Then
                日時確認 = True
            '実績の開始、終了日時がチャート期間をはさむ場合
            ElseIf .Cells(項目, 7).Value < CHART_DATE And _
                .Cells(項目, 8).Value > CHART_DATE + DT Then
                日時確認 = True
            End If
        End If
    End With
 
End Function

 これは項目の番号を入力すると、その項目がチャート範囲内にあるか否かを判断し、チャート範囲内ならば「True」を、範囲外ならば「False」を返します。
 これら2つのFunctionを取り込んだ後の項目データ取得プロシージャーは、

'項目データ取得
Sub 項目データ取得()

Dim I As Integer
Dim J As Integer
Dim K As Integer

    I = 2   '分類のはじめの番号
    '分類の数だけ繰り返す
    Do
        '分類がなくなれば終了
        If Sheet1.Cells(I, 1).Value = "" Then Exit Do
        '分類の名称表示
        Sheet3.Cells(K, 2).Value = Sheet1.Cells(I, 2).Value
        '表示行数になれば終了
        K = K + 1
        If K >= CHART_ROW + CHART_ROWS - 1 Then Exit Sub
        J = 2   '項目のはじめの番号
        '項目の数だけ繰り返す
        Do
            '項目がなくなれば終了
            If Sheet2.Cells(J, 1).Value = "" Then Exit Do
            '分類番号が等しいか否かの確認
            If 分類番号の確認(I, J) Then
                '日時確認処理
                If 日時確認(J) Then
                    'チャート描画処理
                    MsgBox "未作成"
                    '表示行数になれば終了
                    K = K + 1
                    If K >= CHART_ROW + CHART_ROWS - 1 Then Exit Sub
                End If
            End If
            J = J + 1
        Loop
        I = I + 1
    Loop

End Sub

となります。それでは、これを実行するためにして確認するためにモデルデータを作成してみましょう。

 分類、項目それぞれのシート2行目に以下のデータを入力してみましょう。

分類

項目

 項目の日時がチャート内の日付に入るように、チャート開始日を2001年10月1日として、「変数初期化」、「項目データ取得」の順番にマクロを実行してみましょう。
 「未作成」という内容のメッセージボックスが表示されると思います。

 それではいよいよチャート描画プロシージャーの作成に入ります。

チャート描画プロシージャー作成

 図形を描画するのに必要な情報はたくさんあります。位置、形、色、枠線の太さなど、これら全てを自由に設定することができます。
 ここでは位置と形状を使って予定と実績のチャートを区別して表示することにします。

 まず位置について、どのように取得するかです。

 ここで一つ予備知識として重要なポイントは

  1. 1日が1で1時間は1/24
  2. 1は1900/1/1 0:00

です。これを念頭において以下読み進めて下さい。

 チャートの始点は予定、実績の開始日、終点は予定、実績の終了日であることはわかると思いますが、それを取得するのは以下の計算式を用います。

X軸=(「日時」−「チャート開始日」)×「チャート期間の幅」÷チャート日数
Y軸=項目描画行+項目描画行の高さ÷2

 わかりにくいですね。ここでは「チャート期間の幅」、「項目描画行の高さ」などと書いてありますが、それらをどのように取得するのかは結構面倒です。
 説明するよりまず、例を見ましょう。

'チャート描画処理
Sub チャート描画(項目番号 As Integer, 項目描画行 As Integer, 予定 As Boolean)

Dim I As Integer
Dim J As Double
'描画位置用変数
Dim X1 As Double
Dim X2 As Double
Dim Y1 As Double
Dim Y2 As Double
'チャートの全期間幅用変数
Dim X0 As Double

    '予定と実績の別を判断
    If 予定 Then
        I = 0
    Else
        I = 2
    End If
    'チャート日数の設定
    J = CHART_DAYS
    'チャートの全期間の幅を取得
    X0 = Sheet3.Columns(CHART_COL + J).Left - _
        Sheet3.Columns(CHART_COL).Left
    With Sheet2
        'X軸の日付を取得
        X1 = .Cells(項目番号, 5 + I).Value - CHART_DATE
        X2 = .Cells(項目番号, 6 + I).Value - CHART_DATE
        '日付の修正と描画位置への変換
        X1 = 日付の修正(X1, 0, J) * X0 / J + Sheet3.Columns(CHART_COL).Left
        X2 = 日付の修正(X2, 0, J) * X0 / J + Sheet3.Columns(CHART_COL).Left

        '予定と実績の別を判断
        If 予定 Then
            I = 1
        Else
            I = 3
        End If
        'Y軸の取得
        Y1 = Sheet3.Rows(項目描画行).Top + _
            Sheet3.Rows(項目描画行).Height * I / 4
        Y2 = Y1
        '項目名称と担当者を記入
        Sheet3.Cells(項目描画行, 3).Value = .Cells(項目番号, 2).Value
        Sheet3.Cells(項目描画行, 4).Value = .Cells(項目番号, 3).Value

        '線の描画
        MsgBox "未完成"

    End With

End Sub

'日付がチャート範囲外にある場合、値を修正する
Function 日付の修正(修正項目 As Double, 最小値 As Double, 最大値 As Double)

    If 修正項目 < 最小値 Then
        日付の修正 = 最小値
    ElseIf 修正項目 > 最大値 Then
        日付の修正 = 最大値
    Else
        日付の修正 = 修正項目
    End If

End Function

 下にあるFunctionプロシージャーは先に説明したものと同様で、内容を簡便にするためにつけました。
上から順番に処理を説明すると、まず変数を宣言した後、予定と実績の別を判断して、変数Iに0か2を入れます。これは、予定と実績の日時を取得する際に、いちいちそれぞれの列を指定しなくても、同じ構文で取得できるようにするためです。
 次にチャート日数Jを設定します。
 チャート幅X0の取得ですが、最終日+1日の左のセル位置から初日の左のセル位置を引いて取得しています。

 X軸の取得ですが、まず項目にある日付からチャート開始日を引きます。その後、値が(−)や31以上となっている場合はその値を丸め、最終的に日付単位をチャート描画用の単位に変換しています。

 Y軸の取得ですが、まず予定と実績の区別からIの値を1か3に設定します。そして、チャート描画行の上位置に 幅÷4×I したものを足すことで、位置を求めています。

 その後、項目と担当者名を入力して、次はチャートを描画するだけです。

 チャートには線を使用するので、線をマクロで描画する方法を検討します。まず、マクロの記録を使って、シートに線を引いてみます。
 すると以下のようなマクロが作成されます。

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 2001/10/21 by shino
'
 
'
    ActiveSheet.Shapes.AddLine(142.5, 220.5, 279.75, 338.25).Select
End Sub

AddLineの()内の数値は描画する位置によって異なりますが、ヘルプを見ると

expression.AddLine(BeginX, BeginY, EndX, EndY)

とありますので、始点のX,Y、終点のX,Yの順番であることがわかります。
次にもう一度マクロの記録を実行して、線の太さををオートシェイプの書式設定から変更してみます。
すると以下のようなマクロが作成されます。

Sub Macro2()
'
' Macro2 Macro
' Macro recorded 2001/10/21 by shino
'
 
'
    ActiveSheet.Shapes("Line 1").Select
    Selection.ShapeRange.Line.Weight = 1#
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Line.BeginArrowheadLength = msoArrowheadLengthMedium
    Selection.ShapeRange.Line.BeginArrowheadWidth = msoArrowheadWidthMedium
    Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadNone
    Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
    Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
    Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadNoneEnd Sub
End Sub

 この内容は全て把握する必要はありませんが、重要な2点について説明します。
 まず、太さですが

Selection.ShapeRange.Line.Weight = 1#

となっているので、この数値を変更することで、太さを自由に変更できることがわかります。
次に線の形状ですが

Selection.ShapeRange.Line.DashStyle = msoLineSolid

この値が「msoLineSolid」とありますが、これはVBAではじめから定義されている定数です。これを「msoLineSquareDot」とすることで、点線に変更することができます。試しに、「msoLineSolid」と「msoLineSquareDot」に変更してからマクロを実行してみてください。点線が描画されるでしょう。

 それではこれらのことを使って、チャート線追加を行うマクロを作成すると以下のようになります。

'チャート用線の追加マクロ
Sub 線の追加(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double, _
    予定 As Boolean)
    
    Const 線の太さ = 5#
    
    '線の追加と設定
    ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2).Select
    Selection.ShapeRange.Line.Weight = 線の太さ
    If 予定 Then
        Selection.ShapeRange.Line.DashStyle = msoLineSquareDot
    Else
        Selection.ShapeRange.Line.DashStyle = msoLineSolid
    End If
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Line.BeginArrowheadLength = msoArrowheadLengthMedium
    Selection.ShapeRange.Line.BeginArrowheadWidth = msoArrowheadWidthMedium
    Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadNone
    Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
    Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
    Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadNone
    
    Selection.Name = CHART_NAME
End Sub

 やっていることを順番に説明すると、まず先ほど取得した位置情報から線の追加を行い、太さの設定をします。その後、予定であれば点線に、実績であれば実線として、他の初期設定を行います。
 最後にこの線の名前をCHART_NAMEに設定してある名前に変更します。

 線の追加を組み込んだチャート描画プロシージャを以下に示します。

'チャート描画処理
Sub チャート描画(項目番号 As Integer, 項目描画行 As Integer, 予定 As Boolean)

Dim I As Integer
Dim J As Double
'描画位置用変数
Dim X1 As Double
Dim X2 As Double
Dim Y1 As Double
Dim Y2 As Double
'チャートの全期間幅用変数
Dim X0 As Double

    '予定と実績の別を判断
    If 予定 Then
        I = 0
    Else
        I = 2
    End If
    'チャート日数の設定
    J = CHART_DAYS
    'チャートの全期間の幅を取得
    X0 = Sheet3.Columns(CHART_COL + J).Left - _
        Sheet3.Columns(CHART_COL).Left
    With Sheet2
        'X軸の日付を取得
        X1 = .Cells(項目番号, 5 + I).Value - CHART_DATE
        X2 = .Cells(項目番号, 6 + I).Value - CHART_DATE
        '日付の修正と描画位置への変換
        X1 = 日付の修正(X1, 0, J) * X0 / J + Sheet3.Columns(CHART_COL).Left
        X2 = 日付の修正(X2, 0, J) * X0 / J + Sheet3.Columns(CHART_COL).Left

        '予定と実績の別を判断
        If 予定 Then
            I = 1
        Else
            I = 3
        End If
        'Y軸の取得
        Y1 = Sheet3.Rows(項目描画行).Top + _
            Sheet3.Rows(項目描画行).Height * I / 4
        Y2 = Y1
        '項目名称と担当者を記入
        Sheet3.Cells(項目描画行, 3).Value = .Cells(項目番号, 2).Value
        Sheet3.Cells(項目描画行, 4).Value = .Cells(項目番号, 3).Value

        '線の描画
        線の追加 X1, Y1, X2, Y2, 予定

    End With

End Sub

 以上、これら描画マクロを導入するには、項目データ取得プロシージャーの

Msgbox "未完成"

となっている部分を

チャート描画 J, K, True '予定
チャート描画 J, K, False '実績

と置き換えることで、チャートを描画する工程が一通り完成します。

 最後に

'チャート作成
Sub チャート作成()

    Sheet3.Select
    変数初期化
    チャート消去
    項目データ取得

End Sub

というマクロを追加して、実行してみましょう。結果が下図のようになるはずです。

ここまでのファイルをダウンロードできます。

 次はフォームを使って利便性を良くしましょう。フォーム作成