VBA 選択した複数のセルにオートシェイプ(矢印)挿入について 選択したセルに無印挿入まではできたの

VBA 選択した複数のセルにオートシェイプ(矢印)挿入について


選択したセルに無印挿入まではできたのですが複数選択したセルにはどのようにすればいいのでしょうか？
下記コードだと１つ目の選択したセルにしか挿入できません。
すみませんがご教示下さい。


Sub 計画()

Dim R As Range

Set R = Selection

With ActiveSheet.Shapes.AddLine(R.Left, R.Top + R.Height / 2, R.Left + R.Width, R.Top + R.Height / 2).Line

.ForeColor.RGB = RGB(0, 0, 0)

.Style = 1

.BeginArrowheadStyle = 1

.EndArrowheadStyle = 3

.Weight = 1

.DashStyle = msoLineDash

End With

End Sub

No.4 ベストアンサー 回答者： ママチャリ 回答日時： 2020/03/30 21:48

面白いもの作ってますね。

わたしも使いたいです。

Sub 計画()
Dim R As Range
For Each R In Selection.Rows
With ActiveSheet.Shapes.AddLine(R.Left, R.Top + R.Height / 2, R.Left + R.Width, R.Top + R.Height / 2).Line
.ForeColor.RGB = RGB(0, 0, 0)
.Style = 1
.BeginArrowheadStyle = 1
.EndArrowheadStyle = 3
.Weight = 1
.DashStyle = msoLineDash
End With
Next R
End Sub

この回答へのお礼

回答ありがとうございます！
できました！

お礼日時：2020/03/30 22:24

No.3 回答者： tom04 回答日時： 2020/03/30 21:21

No.1です。

あぁ～～～
そういうコトだったのですね。
↓のコードにしてみてください。

Sub Sample2()
　Dim k As Long
　Dim myRng As Range
　Dim c As Range, r As Range

　　For k = 1 To Selection.Areas.Count
　　　Set myRng = Selection.Areas(k)
　　　　Set c = myRng(1)
　　　　Set r = myRng(myRng.Count)
　　　　　With ActiveSheet.Shapes.AddLine(c.Left, c.Top + c.Height / 2, r.Left + r.Width, r.Top + r.Height / 2).Line
　　　　　　.ForeColor.RGB = RGB(0, 0, 0)
　　　　　　.Style = 1
　　　　　　.EndArrowheadStyle = 3
　　　　　　.Weight = 1
　　　　　　.DashStyle = msoLineDash
　　　　　End With
　　Next k
End Sub

※　一つの選択範囲が複数行になっていると
左上から右下への斜めの矢印になってしまいます。m(_ _)m

この回答へのお礼

ありがとうございます！
助かりました！

お礼日時：2020/03/30 22:23

No.2 回答者： fujillin 回答日時： 2020/03/30 21:06

こんばんは

Rがセル範囲の場合、R.Top等はその範囲の最初のセルの値を代表として返します。
セル範囲内の全てのセルに対して同じ処理を行いたい場合は、各セルをループで順に処理すれば宜しいかと。
例えば、変数Rに各セルを代入するとすれば、

For Each R In Selection
'ここにR(=個々のセル)を用いた処理を記述
Next R

のようにして、ご提示の処理をループ内に記述すれば実現できると思います。

この回答へのお礼

参考にします！
ありがとうございます！

お礼日時：2020/03/30 22:24

No.1 回答者： tom04 回答日時： 2020/03/30 20:44

こんばんは！

＞複数選択したセルにはどのようにすればいいのでしょうか？
とは複数行選択した場合はすべての行に矢印を挿入したい！というコトでしょうか？
それとも選択した範囲の左上から右下への斜めの矢印を挿入したい！というコトでしょうか？

とりあえず、すべての行としてみました。

Sub Sample1()
　Dim i As Long
　Dim c As Range, r As Range

　　For i = Selection(1).Row To Selection(Selection.Count).Row
　　　Set c = Cells(i, Selection(1).Column)
　　　Set r = Cells(i, Selection(Selection.Count).Column)
　　　　With ActiveSheet.Shapes.AddLine(c.Left, c.Top + c.Height / 2, r.Left + r.Width, r.Top + r.Height / 2).Line
　　　　　.ForeColor.RGB = RGB(0, 0, 0)
　　　　　.Style = 1
　　　　　.EndArrowheadStyle = 3
　　　　　.Weight = 1
　　　　　.DashStyle = msoLineDash
　　　　End With
　　Next i
End Sub

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

この回答へのお礼

回答ありがとうございます！

>複数行選択した場合はすべての行に矢印を挿入したい！
全ての行ではなく例えば
A3～D3選択+B4～E4選択した状態で
マクロを起動するとその範囲だけ列に平行に矢印が挿入するようにしたいです！

お礼日時：2020/03/30 21:01