エクセル マクロ オートシェイプ 縦線

エクセルのマクロで，以下の条件でオートシェイプの縦線を引きたいと思っています。

条件(1)　縦線を引く範囲は，セルを選択している範囲（任意）の中央を通るようにしたいです。
条件(2)　縦線の太さは一番細い線，色は赤色です。

なお，条件(2)の線の太さ，線の色は，マクロのどの部分を変更すればよいのかもご教授いただけるとありがたいです。

どうぞよろしくお願いいたします。

No.1 ベストアンサー 回答者： tom04 回答日時： 2014/03/30 11:26

こんにちは！

一例です。

複数列を範囲指定する場合もあると思いますので、少し長くなってしまいました。

Sub Sample1()
Dim i As Long, j As Long
Dim c As Range, r As Range
ActiveSheet.Lines.Delete
i = Int((Selection(1).Row + Selection(Selection.Count).Row) / 2)
j = Int((Selection(1).Column + Selection(Selection.Count).Column) / 2)
Set c = Cells(Selection(1).Row, j)
Set r = Cells(Selection(Selection.Count).Row, j)

If (Selection(Selection.Count).Column - Selection(1).Column) Mod 2 = 1 Then
With ActiveSheet.Shapes.AddLine(c.Left + c.Width, c.Top, r.Left + r.Width, r.Top + r.Height).Line
.ForeColor.RGB = vbRed
.Weight = 0.5
End With
Else
With ActiveSheet.Shapes.AddLine(c.Left + c.Width / 2, c.Top, r.Left + r.Width / 2, r.Top + r.Height).Line
.ForeColor.RGB = vbRed
.Weight = 0.5
End With
End If
End Sub

※　線の太さや色は
＞.ForeColor.RGB = vbRed
＞.Weight = 0.5
の行で調整してください。

こんな感じではどうでしょうか？ｍ(_ _)ｍ

この回答へのお礼

お忙しい中にすみんません。
バッチリできました。
ありがとうございました。

お礼日時：2014/03/30 12:00