エクセルのマクロ・ツールで工程表（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 で試しながら、自分のものにしていって下さい。

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