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

質問

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

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

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

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

回答No.1

tom04 · ベストアンサー

こんにちは！
一例です。

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

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
の行で調整してください。

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

お礼

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