Excel Macro で工程表（Gantt Chart）のツール（完結編）

皆さん、こんばんは。

今回は、完結編として工程表でジグザク線を自動で書かせてみたいと思います。
一応、このシリーズはこれで終わりの予定です。

以下に、マクロのスクリプトを書いておきます。

Sub ZigzagLine()
'
' ZigzagLine Macro
'
Dim i As Integer
Dim SSD As Double
Dim SD As Double
Dim ED As Double
Dim p As Double
Dim Dulation As Double
Dim X1 As Double
Dim Y1 As Double
Dim X2 As Double
Dim Y2 As Double
Dim X3 As Double
Dim Y3 As Double
Dim a As Single
Dim colval As Single
Dim L As Double
If Not TypeName(Selection) = "Range" Then Exit Sub
i = Selection.Cells.Row
SD = Cells(i, 3).Value
ED = Cells(i, 4).Value
p = Cells(i, 9).Value
SSD = Cells(8, 10) 'To adjust with First Date Cell
X1 = Cells(8, 10).Left + (SD - SSD) * 25.5 + (ED - SD + 1) * p * 25.5
If X1 < Cells(8, 10).Left Then X1 = Cells(8, 10).Left a = 3 Else If X1 > Cells(8, 52).Left Then
X1 = Cells(8, 52).Left
a = 3
Else
a = 2
End If
End If
Y1 = Selection.Top + Selection.Height / a
X2 = Selection.Left
Y2 = Selection.Top
X3 = Selection.Left
Y3 = Selection.Top + Selection.Height
If Cells(i, 6).Value = "" Then Exit Sub
If Cells(8, 51).Value < Cells(i, 3).Value Then Exit Sub If a = 2 Then With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, X2, Y2) .AddNodes msoSegmentLine, msoEditingAuto, X1, Y1 .AddNodes msoSegmentLine, msoEditingAuto, X3, Y3 .ConvertToShape.Select End With Else With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, X2, Y2) .AddNodes msoSegmentLine, msoEditingAuto, X1, Y1 .AddNodes msoSegmentLine, msoEditingAuto, X1, Selection.Top + Selection.Height * 2 / a .AddNodes msoSegmentLine, msoEditingAuto, X3, Y3 .ConvertToShape.Select End With End If If X1 > X2 Then
colval = 12
Else
colval = 10
End If
Selection.ShapeRange.Line.Weight = 3.25
Selection.ShapeRange.Line.ForeColor.SchemeColor = colval
Cells(i + 1, 22).Activate 'To adjust with Next Start Date Cell
End Sub



【ちょっと解説】
C,D,Eの各列に予定工程の開始、終了、工数を書き込み、F,G,Hには実績工程のものを書き込んでおきます。

I列には進捗率を記入したうえで、ジグザグ線を記入したい行の管理日（ジグザグ線の始点となる日）を左側に置いたうえで上記のマクロを実行します。

進捗が遅れていれば赤線で、進んでいれば青線で、また、計画に対しての進捗率が表の中であれば三角に、工程表からはみ出るようであれば台形になるようになっています。

案の定、スパゲッティ・プログラムなので見難い（恥ずかスイ^^;）でしょうが、皆さんのそれぞれの工程表に合わせて、作り直してから使ってみて下さい。

今までの解説したサンプルファイルを置いておきますので、ここからダウンロードして各自使ってみて下さい。
何よりも、『習うより慣れろ』です。

それでは又、御機嫌よう…

Excel Macro で工程表（Gantt Chart）のツール（前回の答え）

皆さん、こんにちは。

前回では３つのツールをExcel Macro で作りましたが、その中で宿題を出しておりました。

今回は、その答え合わせをします。

回答は、１番目（選択範囲にバーを引くマクロ）と２番目のマクロ（作業開始日（Start Date）・終了日（Finish Date）からバーを引くマクロ）を改良しなければ、一つのセルが２日以上の時には使えない、というものです。

以下にそれぞれの正解マクロを書き出します。


●　選択範囲にバーを引くマクロの改良版

Sub Square_mod()
'
' Square_mod Macro
'
Dim X As Double
Dim Y As Double
Dim X2 As Double
Dim Y2 As Double
Dim L As Double
Dim DW As Double
Dim s As Single
Dim E As Single
Dim i As Integer
If Not TypeName(Selection) = "Range" Then Exit Sub
i = Selection.Cells.Row
DW = Cells(8, 6).Width / Cells(1, 43).Value
Cells(i, 5).Value = Selection.Columns.Count * Cells(1, 43).Value 'duration
s = Int((ActiveCell.Left - Cells(8, 6).Left) / DW) + Cells(8, 6)
E = s + Cells(i, 5) - 1
Cells(i, 3).Value = s 'start date
Cells(i, 4).Value = E 'end date
L = 9#
X = Selection.Left
Y = Selection.Top + L / 2
X2 = Selection.Width
Y2 = Selection.Height - L
ActiveSheet.Shapes.AddShape(msoShapeRectangle, X, Y, X2, Y2). _
Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 47
Selection.ShapeRange.Line.Weight = 1.25
With Selection
.Placement = xlMove
.PrintObject = True
End With
End Sub


●　作業開始日（Start Date）・終了日（Finish Date）からバーを引くマクロの改良版

Sub Dulation_mod()
'
' Dulation_mod Macro
'
Dim i As Integer
Dim SSD As Double
Dim SD As Double
Dim ED As Double
Dim Dulation As Double
Dim DW As Double
Dim X1 As Double
Dim Y1 As Double
Dim X2 As Double
Dim Y2 As Double
Dim L As Double
If Not TypeName(Selection) = "Range" Then Exit Sub
i = Selection.Cells.Row
SD = Cells(i, 3) 'To adjust with Start Date Cell
ED = Cells(i, 4) 'To adjust with End Date Cell
Dulation = ED - SD + 1
SSD = Cells(8, 6) 'To adjust with First Date Cell
DW = Cells(8, 6).Width / Cells(1, 43).Value
Range(Cells(i, SD - SSD + 6), Cells(i, Int((ED - SSD) / DW))).Select
L = 9#
X1 = (SD - Cells(8, 6)) * DW + Cells(8, 6).Left
Y1 = Selection.Top + L / 2
X2 = Dulation * DW
Y2 = Selection.Height - L
ActiveSheet.Shapes.AddShape(msoShapeRectangle, X1, Y1, X2, Y2). _
Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 47
With Selection
.Placement = xlMove
.PrintObject = True
End With
Cells(i, 5).Value = Dulation 'To adjust with Dulation Column
Cells(i + 1, 3).Activate 'To adjust with Next Start Date Cell
End Sub


詳しくは自分で確認して見るとわかると思いますが、Cells(1, 43) = AQ1 セルに、セル一つ毎の日数を記入する欄を設け、それを変える毎に勝手に日数の計算の修正をしてくれるようになっています。

前回のマクロとの違いをそれぞれよーく見比べてみて下さい。

では又。

エクセルのマクロ・ツールで工程表（Gantt Chart）を便利に！

ご無沙汰しております。
久しぶりに自分のコンテンツで更新する気になりました。

今回は、趣向を凝らして、表題の通りに、エクセルで工程表を作るに当たり、自分が使っているマクロ・ツールを３つほど、公開してみようと思います。

これらのマクロをショートカット・キーに登録しておけば、大概の工程表はエクセルで手早く作ることが出来る筈です＾＾。

まずは、週間工程、又は月間工程表を下の例のように準備します。

★　週間工程表

★　月間工程表

表記が英語で書かれているのは、こちらの仕事の都合ですのでご容赦をｗ


ここで、F8セルに工程表の最初の日付がくるように作っていますが、これは後でマクロで参照させる要（かなめ）となります。
この位置を変更させたい方は、マクロの中の Cells(8,6) という記述を変える必要があります。

また、各項目の作業開始日（Start Date）・終了日（Finish Date）と作業日数（Dulation）も、それぞれC/D/E列でマクロは記述させております。
AQ1（＝Cells(1,43)）セルには、週間工程では１列１日表示なので１を、他の、例えば１列７日表示の場合は７を入れて参照しています。


言い忘れましたが、なぜ私がエクセルで工程表を書いているのかといえば、ひとえに表現力の違いです。

Micro Soft Project やPrima Vela では作業単位の設定、主要設備・労働力の分散（俗にいう山崩し）や、原価管理、プロジェクトごとの工程管理などに絶大な威力を発揮できることは言うまでもないのですが、例えば、下のような表現力は持ち合わせておりません。

★　サンプル

どうでしょうか、私がエクセルにこだわり続ける心情を少しでも察して頂けたでしょうか？


で、いきなりマクロ表記に入ります。

●　まずは選択範囲にバーを引くマクロです。

Sub Square1()
'
' Square1 Macro
'
Dim X As Double
Dim Y As Double
Dim X2 As Double
Dim Y2 As Double
Dim L As Double
Dim s As Single
Dim E As Single
Dim i As Integer
If Not TypeName(Selection) = "Range" Then Exit Sub
i = Selection.Cells.Row
Cells(i, 5).Value = Selection.Columns.Count * Cells(1, 43).Value 'duration
s = ActiveCell.Columns(ActiveCell.Columns.Count).Column + Cells(8, 6) - 6
E = s + Cells(i, 5) - 1
Cells(i, 3).Value = s 'start date
Cells(i, 4).Value = E 'end date
L = 9#
X = Selection.Left
Y = Selection.Top + L / 2
X2 = Selection.Width
Y2 = Selection.Height - L
ActiveSheet.Shapes.AddShape(msoShapeRectangle, X, Y, X2, Y2). _
Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 47
Selection.ShapeRange.Line.Weight = 1.25
With Selection
.Placement = xlMove
.PrintObject = True
End With
End Sub


以上を標準モジュールの中（例えばModule1）に入れておきます。
その上で、工程表の中の同一行でバーを引きたい範囲を選んでおいてから、マクロを実行してみます。

どうでしょうか？ちゃんとマクロが動いていれば、バーが引けると同時に、Start Date・Finish Date・Dulationまで表示してくれるはずです。


●　次に、作業開始日（Start Date）・終了日（Finish Date）からバーを引くマクロです。

Sub Dulation()
'
' Dulation Macro
'
Dim i As Integer
Dim SSD As Double
Dim SD As Double
Dim ED As Double
Dim Dulation As Double
Dim X1 As Double
Dim Y1 As Double
Dim X2 As Double
Dim Y2 As Double
Dim L As Double
If Not TypeName(Selection) = "Range" Then Exit Sub
i = Selection.Cells.Row
SD = Cells(i, 3) 'To adjust with Start Date Cell
ED = Cells(i, 4) 'To adjust with End Date Cell
Dulation = ED - SD + 1
SSD = Cells(8, 6) 'To adjust with First Date Cell
Range(Cells(i, SD - SSD + 6), Cells(i, ED - SSD + 6)).Select
L = 9#
X1 = Selection.Left
Y1 = Selection.Top + L / 2
X2 = Selection.Width
Y2 = Selection.Height - L
ActiveSheet.Shapes.AddShape(msoShapeRectangle, X1, Y1, X2, Y2). _
Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 47
With Selection
.Placement = xlMove
.PrintObject = True
End With
Cells(i, 5).Value = Dulation 'To adjust with Dulation Column
Cells(i + 1, 3).Activate 'To adjust with Next Start Date Cell
End Sub


作業開始日、終了日に日付を入力したら、同一行にカーソルを置いた状態でマクロを実行してみて下さい。

バーが表示され、作業日数まで表示されたら成功です。


●　最後に、上記２つのマクロで書かれたバーを、微調整をした上で、Start Date ・Finish Date 並びにDulation を変更してくれるマクロです。

Sub ReadShapeData()
'
' Read Shape Date Macro
'
Dim i As Integer
Dim N As Double
Dim L As Double
Dim W As Double
If TypeName(Selection) = "Range" Then
MsgBox "Please select shape object.", vbCritical
Exit Sub
End If
With Selection.ShapeRange
Cells(Selection.TopLeftCell.Row, 3).Value = Cells(8, 6) + (.Left - Cells(8, 6).Left) / (Cells(8, 6).Width / Cells(1, 43).Value)
Cells(Selection.TopLeftCell.Row, 4).Value = Cells(Selection.TopLeftCell.Row, 3) + .Width / (Cells(8, 6).Width / Cells(1, 43).Value) - 1
Cells(Selection.TopLeftCell.Row, 5).Value = Cells(Selection.TopLeftCell.Row, 4) - Cells(Selection.TopLeftCell.Row, 3) + 1
End With
End Sub

上記のマクロを、修正したShapes Object を選択したままで実行してみて下さい。

ちゃんとした日付が返されれば大成功です。


とすらすらと書いていきましたが、上記３つのマクロを試していくと、上の内の２つのマクロは、月間工程表ではそのままでは使えないことに気づいたはずです。

書かれているコードよく読んで、多少頭をひねって考えれば、どうすれば使えるようになるかは分かるかと思います。
分からない方は、google先生に教えてもらいましょう。ggrksと書くと少し下品ですが…

これは皆さんへの宿題にしておきましょう＾＾）

何事も、Try & Error で試しながら、自分のものにしていって下さい。

それではまた来週お会いしましょう！