派遣事務員の迷走

派遣事務員コロ子。会社の犬。顔出しNG。常に迷走している。

Excelの表で行が増えたら一緒に図形も動く(自動追尾型)

こんにちは。
コロ子です。


コロ子の仕事でExcel VBAで図形を使う事ってあんまりないけど、
先日「行が増えたら図形も一緒に動かないの?」と言われたので
こんなのを作ってみました。
地味に便利なので超初心者の人にコピペで作ってみんなに自慢してもらいたい。
(ただし誰にも「すごい」とは言ってもらえない)

Excelの表で行が増えたら一緒に図も動く(自動追尾型)のマクロ

Excelの表でこんなふうに図形を使ってる場合

f:id:SNegishi:20190310172110p:plain

行が増えたら図形も一緒に下に移動したい。

①図形の名前を確認する

まず青い四角の図形を選択する。

f:id:SNegishi:20190310175417p:plain

VBEエディタのイミディエイトウィンドウに
?Selection.nameと入力しリターンを押す。

f:id:SNegishi:20190310174845j:plain

TextBox 1と表示される。
これが青い四角の名前。

同様にピンクの吹き出しの名前を確認する。

ピンクの吹き出しを選択して
イミディエイトウィンドウに
?Selection.name
と入力してリターン。

f:id:SNegishi:20190310175905p:plain

ピンクの吹き出しの名前は
Rounded Rectangular Callout 5
だと分かった。
けどRounded Rectangular Callout 5って・・・。
図形の名前って1から順番に自動採番されるから5回やり直してるのがバレる!
挙動不審なので名前を付け直します。

Rounded Rectangular Callout 5 → Pink に変更します。

ピンクの吹き出しを選択した状態で
イミディエイトウィンドウに
Selection.name = "Pink"
と入力。
確認の為もう一度
?Selection.nameと入力してPinkになっていることを確認。

f:id:SNegishi:20190310211143p:plain

ついでに青い四角の図形のTextBox 1もBlueに変更します。
青い四角の図形を選択してイミディエイトウィンドウに
Selection.name = "Blue"
と入力。

②図形が移動するコードを書く

コードを書く場所
f:id:SNegishi:20190310212351p:plain

①対象のシート(この場合は管理簿という名前のシートになってる)を選択。
②Worksheetを選択。
③SelectionChangeを選択。


下記のコードを書く

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 1 Then

     Shapes("Blue").Top = ActiveCell.Offset(5, 0).Top
     Shapes("Pink").Top = ActiveCell.Top

End If

End Sub

【説明】
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
別のセルにカーソルが移った時にマクロが動く

If Target.Column = 1 Then
選択したセルが1行目のとき(日付を入力したとき)

Shapes("Blue").Top = ActiveCell.Offset(5, 0).Top
図形Blueの上辺は選択したセルの5行の下の位置に

Shapes("Pink").Top = ActiveCell.Top
図形ピンクの上辺は選択したセルの位置に

できた?
そもそもExcelの表にこんな用途で図形を使っている人っているのかな?

補足

図形のプロパティを

  • 「セルに合わせて移動するがサイズは変更しない」にチェックを入れると行を削除したり、オートフィルタをしても図形の形が崩れない。
  • 「オブジェクトを印刷する」のチェックをはずせば図形はプリントされない。

f:id:SNegishi:20190311071926p:plain