日報に自動で矢印線をひきたい

会社で部署内の人（約10人）がその日に何をやったかといった日報をエクセルで作っています。タイムテーブル（縦列に名前、横列に8時～22時までの30分間隔で作ってあります）に矢印を引っ張って、その上にどのような仕事をしたのかを入力していくのですが、勤務がシフト制のため、９時出社、11時出社、13時出社といった具合にバラバラで、矢印を引っ張るのに苦労しています。

そこで、名前の横のセルに９と入力しただけで9時～18時の時間帯に、また11と入力しただけで11時～20時の時間帯に自動で矢印線が作成できるソフトかマクロをさがしています。

どなたか教えてください。よろしくお願いいたします。

No.1 ベストアンサー 回答者： hige_082 回答日時： 2009/03/08 03:56

詳細が分からないので

Ａ列に名前、Ｂ列に9か11の入力、Ｃ列～ＡＥ列に時間（8時～22時までの30分間隔）としています

'シートモジュールへコピペ
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("b:b")) Is Nothing Then Exit Sub
Dim s_lef, e_lef
Dim s_wid, e_wid
Dim s_str, e_end
Dim se_hei
se_hei = Target.Top + Target.Height * 0.7
If Target = 9 Then
s_lef = Target.Offset(0, 3).Left
s_wid = Target.Offset(0, 3).Width
e_lef = Target.Offset(0, 21).Left
e_wid = Target.Offset(0, 21).Width
ElseIf Target = 11 Then
s_lef = Target.Offset(0, 11).Left
s_wid = Target.Offset(0, 11).Width
e_lef = Target.Offset(0, 25).Left
e_wid = Target.Offset(0, 25).Width
Else
Exit Sub
End If
s_str = s_lef + s_wid / 2
e_end = e_lef + e_wid / 2
ActiveSheet.Shapes.AddLine(s_str, se_hei, e_end, se_hei).Select
With Selection.ShapeRange.Line
.BeginArrowheadStyle = msoArrowheadOpen
.EndArrowheadStyle = msoArrowheadOpen
.BeginArrowheadWidth = msoArrowheadWidthMedium
.BeginArrowheadLength = msoArrowheadLengthMedium
.EndArrowheadWidth = msoArrowheadWidthMedium
.EndArrowheadLength = msoArrowheadLengthMedium
.Visible = msoTrue
End With
End Sub

エラー処理はしていません
アレンジはご自分でしてください

この回答へのお礼

ずばりストライクといった回答です。ありがとうございました。ほんとに感謝しています。

お礼日時：2009/03/08 20:36