矢印オートシェイプは調整が面倒
Excelで資料を作成する際に、ここからここへ、という明示をするために矢印のオートシェイプを使うことがあります。
こんな感じで表形式の左から右へ、みたいな感じとかですね。実はこの矢印は後述のマクロでやってます。３本引くのに10秒も掛かっていません。
通常はこのように左から右に、という具合に手で矢印を引くのですが、いろいろと難点があります。
水平、垂直になってない。
グリッドとずれる。
他の矢印とずれる。
と、思ったようにいきません。
この微調整に掛かる時間がもったいないですよね。
そこで、選択セル範囲の開始セルから終了セルにこんな感じで矢印のオートシェイプを引くマクロを紹介します。
私自身もクイックアクセスツールバーに登録して重宝しています。
色は赤で太さを1.5ポイントにしていますが、RGB関数と数字を1.5と書いてるソースなので、修正したい場合はそこだけ変えればOKです。
選択セルの開始セルから終了セルに矢印を引く関数
以下に紹介する矢印を引くマクロはいくつかの制限事項があります。
- セルを１つしか選択していない場合はそのセル内の左から右に矢印を引きます。
- 矢印はセルの高さの中央を開始と終了位置にしています。
- 矢印は赤色にしています。違う色にしたいときはRGB関数の値を変えてください。
- 矢印の太さは1.5ポイントです。これも数値を変えれば太さが変わります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 |
Sub CreateArrowSelection() Dim r As Range '// 選択セル範囲 Dim rStart As Range '// 開始セル Dim rEnd As Range '// 終了セル Dim iRowStart As Long '// 先頭行 Dim iRowEnd As Long '// 最終行 Dim iColStart As Long '// 先頭列 Dim iColEnd As Long '// 最終列 Dim iPairRow As Long '// 終了セル行 Dim iPairCol As Long '// 終了セル列 Dim dStartY As Double '// 開始セルの縦位置 Dim dStartX As Double '// 開始セルの横位置 Dim dEndY As Double '// 終了セルの縦位置 Dim dEndX As Double '// 終了セルの横位置 '// 選択セル範囲を保持 Set r = Selection '// 先頭行 iRowStart = Selection.Row '// 最終行 iRowEnd = Selection.Rows.Count + iRowStart - 1 '// 先頭列 iColStart = Selection.Column '// 最終列 iColEnd = Selection.Columns.Count + iColStart - 1 '// アクティブセルを開始セルに設定 Set rStart = ActiveCell '// 開始セルが上の行の場合 If (rStart.Row = iRowStart) Then '// 対になる終了セル行は下の行を設定 iPairRow = iRowEnd Else '// 対になる終了セル行は上の行を設定 iPairRow = iRowStart End If '// 開始セルが左の列の場合 If (rStart.Column = iColStart) Then '// 対になる終了セル列は左の列を設定 iPairCol = iColEnd Else '// 対になる終了セル列は右の列を設定 iPairCol = iColStart End If '// 開始セルと終了セルを取得 Set rEnd = Cells(iPairRow, iPairCol) '// 開始セルが終了セルより左にある場合 If (rStart.Left <= rEnd.Left) Then '// 開始セルの左端を開始横位置に設定 dStartX = rStart.Left '// 終了セルの右端を終了横位置に設定 dEndX = rEnd.Left + rEnd.Width Else '// 開始セルの右端を開始横位置に設定 dStartX = rStart.Left + rStart.Width '// 終了セルの左端を終了横位置に設定 dEndX = rEnd.Left End If '// 開始行位置を開始セルの中央の高さ位置に設定 dStartY = rStart.Top + (rStart.Height / 2) '// 終了行位置を終了セルの中央の高さ位置に設定 dEndY = rEnd.Top + (rEnd.Height / 2) '// 開始セルから終了セルを選択 ActiveSheet.Shapes.AddConnector(msoConnectorStraight, dStartX, dStartY, dEndX, dEndY).Select '// 開始セルから終了セルを選択（2003などはこちら） ' ActiveSheet.Shapes.AddConnector(msoConnectorStraight, dStartX, dStartY, dEndX - dStartX, dEndY - dStartY).Select '// 矢印オートシェイプの種類を設定 Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle '// 矢印の色 Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0) '// 矢印の線の太さ Selection.ShapeRange.Line.Weight = 1.5 '// 選択セル範囲を再選択 r.Select End Sub |
コード説明
考え方は以下のような流れです。
- 選択セル範囲の上下左右のセル位置を取得。
- アクティブセルを開始セルとし、その対角にあたるセルを終了セルとする。
- 開始セルが終了セルの左右、上下のどちらにあるかで矢印の開始と終了位置を設定する。
- 矢印を引く。
細かい処理はコメントに書いている通りです。考え方で難しいのは3番の矢印を引く開始横位置と終了横位置です。左から右に引く場合と右から左に引く場合で開始と終了の横位置が変わります。
なお、Office2003と2007あたりでAddConnector関数の挙動が異なっています。2003以前の場合は71行目を削除して73行目の方を使ってください。
使い方
1. 矢印を引きたい範囲を選択します。このとき、矢印を引きたい方向と同じ向きにセル範囲を選択します。この例ではA1セルを開始セルとしてC4セルまでを選択しています。
2. CreateArrowSelection()を実行します。
他にも以下のように開始セル（Start）から終了セル（End）に向かってセル範囲を選択した場合のパターンでも利用できます。
“VBAで選択セルの開始から終了に矢印オートシェイプを引く” への1件のフィードバック