進捗管理もできちゃう Excel△ (棒読み)
ドキュメントをコツコツと書き上げる工程も終わって、やっと方眼紙 Excel からおさらばできるぜ！ と思ったら、線表…だと……。Excel さん働き過ぎｗｗｗｗ
できれば、おまいらにはこんな不幸が訪れないことを願っているんだが、万が一不幸に見舞われたときのために、お役立ちメモを残しておくぜ
営業日の数え方
「NETWORKDAYS」ワークシート関数を使うと良い。使い方はヘルプ見れ。開始日、終了日のほかに祝日を指定できる優れもの！ でも分析ツールのアドインを入れないと使えない憎いやつ。
分析ツールの入れ方は、 Excel起動→メニューバーの「ツール」→「アドイン」で開いたウィンドウから「分析ツール」をチェックして「OK」を押せばよろし
あとは、ヘルプどおりに使えば、土日祝日を除いた営業日を返してくれる。遅延日数なんかを計算するのに地味に便利
線の引き方
タスクはオートシェープの四角形で引くのが好きなので、その方法
オートシェープで四角形を描くには↓な感じでOK、更に Left, Top には Range オブジェクトのそれを指定できる。
ワークシートオブジェクト.Shapes.AddShape(msoShapeRectangle, 左座標, 上座標, 幅, 高さ)
サンプルコードはこんな感じ
Sub DrawTasks()
Dim b As Workbook
Dim ws As Worksheet
Dim target As Range
Dim task As Shape
Set b = ThisWorkbook
Set ws = ThisWorkbook.Sheets(1)
Set target = ws.Range("A1:C1")
With target
' コレで A1 ～ C1 にぴったりサイズの四角形が書ける。
Set task = ws.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height)
task.Fill.ForeColor.SchemeColor = 41
End With
Set target = ws.Range("A2:C2")
With target
' 細くするときはこんな感じ 1/3 の高さの線が真ん中に引ける。
Set task = ws.Shapes.AddShape(msoShapeRectangle, .Left, .Top + .Height / 3, .Width, .Height / 3)
task.Fill.ForeColor.SchemeColor = 42
End With
Set target = ws.Range("A3:C3")
With target
' 予定
Set task = ws.Shapes.AddShape(msoShapeRectangle, .Left, .Top + .Height / 6, .Width, .Height / 3)
task.Fill.ForeColor.SchemeColor = 43
' 実績
Set task = ws.Shapes.AddShape(msoShapeRectangle, .Left, .Top + .Height / 2, .Width, .Height / 3)
task.Fill.ForeColor.SchemeColor = 44
' みたいなこともできる
End With
End Sub
このサンプルだと、実行するたびにオートシェープがガンガン重なっていくので、オートシェイプを書く前に削除しないといけないんだけど、削除はかなり厄介。何も考えずに Shapes をぐるぐる回して全部消しちゃうと、メモで残しておいたテキストボックスとかそういうのも全部消えちゃって、切ないことになるし。
とりあえず個人的に現時点で最善だとおもうやり方は、対象のセルを上から For Each でまわして、一行の範囲に納まっている Shape を削除するという方法。これだと、セルを複数行にまたいでいる Shape は消えないからほとんどの場合、期待通りに動きそう。更に Shape の Type が msoShapeRectangle のときだけ消すとか、その辺のチェックを入れておけばほぼ大丈夫かなと思ったり。
2011/12/26 追記 その後、良いやり方を発見した。オートシェープを追加したタイミングで、適当な名前（例えば「予定_行番号」)を付けておいて、次回は、「予定_」という名前で始まるオートシェープを削除すれば、ある程度狙ったオートシェープだけ消せるはず。
良く考えたら Excel で線表引いてる時点で最善もクソもないんだけどなｗｗｗ
というワケで削除のサンプル
Sub DeleteTasks()
Dim b As Workbook
Dim ws As Worksheet
Dim target As Range
Dim s As Shape
Dim r As Range
Set b = ThisWorkbook
Set ws = ThisWorkbook.Sheets(1)
Set target = ws.Range("A1:A10")
For Each s In ws.Shapes
If s.Type = msoShapeRectangle Then
' 消す テキストボックスは消えないけど、四角形とか楕円なんかはきえちゃう
's.Delete
End If
Next s
For Each r In target
For Each s In ws.Shapes
' 1行目から10行目の行をまたいでいない shape が全部消える。
' 上の Type の判定と合わせて使っても良さそうだけど、ちょこっと使うツール
' としてはこっちだけで十分 ただ、線表が大きくなるとループ回数が気になる。
If s.Top > r.Top And (s.Top + s.Height) < (r.Top + r.Height) Then
s.Delete
End If
Next s
Next r
End Sub
とまぁこの辺を組み合わせれば線表は引ける。あとはリソースの重なりをチェックしたり、稲妻線を出したり、進捗管理をするためには、まだまだ色々必要そうだな。ちなみに、我が家では Excel2000 が現役なんで、サンプルは Excel2000 のサンプルな。
![Windows PowerShell イン アクション [イン アクションシリーズ]](http://ecx.images-amazon.com/images/I/41w01-n0YpL._SL160_.jpg)
