知らずに落ちると抜け出せなくなるVBAの落とし穴です。
- For Each ですべての図形を処理したとき途中で変な動きをする
- Shapes.Countで図形を数えるとなぜか1個多い
- 入力規則の▼が消えてリストから選べなくなった
あたりにお悩みの方は、この落とし穴に落ちていないかご確認ください。
ドロップダウンリストの▼はShapeオブジェクト
ワークシート.Shapesコレクションで取得できるShapeたちには、入力規則でリスト入力できるように設定したドロップダウンリストの▼が含まれます。
適当にテキストボックスをいくつか作り、そのシートに入力リストを設置して、
↓のコードを実行してみてください。
Sub Shapeオブジェクトの名前をすべて取得する() Dim shp As Shape For Each shp In ActiveSheet.Shapes Debug.Print shp.Name Next End Sub ' 実行結果 TextBox 1 TextBox 2 TextBox 3 Drop Down 1
このように、Shapesの中にドロップダウンリストが含まれていることが分かります。
こいつは結構謎な動きをするやつで、
まず入力リストをたくさん設置しても、
Drop Downはひとつ分のShapeにしかなりません。
なのに、名前はDrop Down 2 とかになることもあります。
カウントが増える条件もよくわからなくて、つけ外ししても1のままなのに、
なんか気が付いたら4とかになってます。
Shp.Topなどで位置を取得すると、最後に設置した場所を返しているように見えますが、本当にそうなの？といわれると自信がありません。
あとは入力規則のあるシートをコピーすると、
コピーした直後はShapesコレクションの中にいません。
さっきのFor文を回すと、なぜか
TextBox 1 TextBox 2 TextBox 3
が返ってきます。
そして入力リストから1回何かを選んで入力すると、
晴れてShapesコレクションに仲間入りを果たします。
なんやこいつ(´∀｀;)
対処法
ということで、まともに何かに使うことはありませんので、
Sub Shapeオブジェクトの名前をすべて取得する() Dim shp As Shape For Each shp In ActiveSheet.Shapes If Not shp.Name Like "Drop Down *" Then ' ここにすべての図形への処理を書く Debug.Print shp.Name End If Next End Sub
と、「オブジェクトの名前がDrop Downから始まっているか」で判定して弾いてください。
If Left(Shp.Name, 9) <> "Drop Down" Then
でももちろんOKです。
よくある被害
上記の通りFor Eachですべての図形を処理しようとしたとき、
不思議な挙動になってしまうのが一番ありがちな被害です。
あとは図形を挿入するマクロなどで、Shapes.Countを数えて処理をコントロールしたいときにも邪魔されたことがあるのでご注意ください。
DropDownのShapeを削除すると▼が消える
発生する被害の中で、最も困るのが▼が消せてしまう問題です。
↓のコードで「シート内のすべての図形を削除」したとき、
Sub すべての図形を削除する() Dim shp As Shape For Each shp In ActiveSheet.Shapes shp.Delete Next End Sub
DropDown.Deleteが普通に実行できて、なんと▼が消えます。
▼が消えて入力リストからはもう選べないのですが、
それでも入力規則だけは生きているので、
手で正しい値を入力しないと弾かれるひどいセルと化します。
しかもこの▼はもう復元できないようです。
入力リストを再度設置してもダメですし、
他のシートから入力規則セルをコピーしてきてもダメ。
新しい入力規則を設定しても、それにも▼はつきません。
もう「シートが破損した」といってもいい状態ですよね。
そのシートオブジェクトである限りもう復元はできないようですが、
一応「シート全体ごと他のシートにコピーする」と、
この破損状態はコピーされず、新しいシートでは▼が出るようです。
せめて
shp.Delete
がエラーになってくれるとよかったんですけどね。
仕様というかもうバグだろ！って言いたくなる挙動ですが、
そんなこと言ってもしょうがないのでしっかり自衛していきましょう。
