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

Question

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

ママチャリ · Accepted Answer

面白いもの作ってますね。わたしも使いたいです。

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

tom04 · Answer

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

fujillin · Answer

こんばんは

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

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

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

tom04 · Answer

こんばんは！

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

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

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

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

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

No.1です。

こんばんは

こんばんは！

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

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