[Excel VBA] 工程表の作成 -VBAによるShapeの描画- (2)

|

 前回のコードでは、複数行を選択したときにでもその複数行の中央にラインが引かれてしまいます。工程表で必要なラインは一行で十分ですので、一行選択したときのみラインを引くように制限します。

    ' 2行以上の場合メッセージを出して終了
    If Selection.Rows.Count > 1 Then
        MsgBox "1行のみ選択して下さい。"
        Exit Sub
    End If

また、工程表のラインは「予定」と「実績」があります。ラインカラーを「予定=青」「実績=赤」とすることとし、条件分けによって同じコードでラインを引き分けることとします。

偶数・奇数行の選択はテンプレートによって変わるでしょうから、適宜修正して下さい。

    ' 選択行によるラインカラーの設定(偶数:青 奇数:赤)
    If (Selection(1).Row Mod 2) = 0 Then
        ColorR = 0
        ColorG = 0
        ColorB = 255
    Else
        ColorR = 255
        ColorG = 0
        ColorB = 0
    End If

    ' 工数ラインをプロットする
    With ActiveSheet.Shapes.AddLine(X0, Y0, X1, Y1).Line
        .ForeColor.RGB = RGB(ColorR, ColorG, ColorB)
        .Weight = 4
    End With

偶数・奇数の条件分けは選択した行番号を2で割って余りがなければ偶数行という単純な方法です。それぞれの場合に、RGBの数値を指定しておき、プロットに反映させます。

---

次に描画範囲の設定をします。設定というか、どこにでもラインが引けてしまうのは表としていかがなものかと思うので、指定した範囲外には描画できないようにします。これも最初に作るテンプレートにより変わるので適宜修正して下さい。

私が作ったテンプレートはこれです。

これについて、描画範囲は以下のようになります。

選択範囲の左上と右下が描画範囲を外れていれば描画させないようにします。

    ' 選択範囲が工程表外の場合メッセージを出して終了
    If Selection(1).Row < 10 Or Selection(1).Column < 6 Then
        MsgBox "描画範囲外です。"
        Exit Sub
    End If
    If Selection(Selection.Count).Row > 47 Or _
       Selection(Selection.Count).Column > 83 Then
        MsgBox "描画範囲外です。"
        Exit Sub
    End If

次回は「協議」時のアイコンの描画について書きます。

 

カスタム検索
Access Counter
Powered by Movable Type 4.22-ja

2016年9月

Sun Mon Tue Wed Thu Fri Sat
        1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30  

最近のブログ記事