
次の入力する仕組みをまず見ていただきます。
クリックしたところが4行目に反映されてそこでデータの入力ができるようになります。
でも、これだけのアクションだとどこの行が実際に変更箇所になっているか、クリックしてしまってそこを確認し間違えたらそこで違うものを変更してしまう可能性もあると思いました。
それを防止するためにはたくさんの方法があるでしょう。
その中でもちょっと面白いなと思うような効果が作成することができたので、公開してみようと思います。
クリックしたらその場所に書いてある内容をピクチャにして、それを4行目まで動かすようなアニメーションがあると分かりやすいかなと思います。
そこで考えたのが、シートに対するイベントの場合、クリックしたセルはTargetに入りますので、Target.Rowでその行番号が分かるのですが、そこに合わせたセル範囲を図としてコピーし、そのままの位置に貼り付けて、そのままだとピクチャを選んだ状態になってしまうので、貼り付けた直後にshpという変数名にして、Targetのセルを選択してピクチャの選択を外し、ピクチャを真っ白にした状態から普通の状態まで色を変化させて、その後、1行ずつピクチャの位置を上に上げていき、4行目まで移動させていって、最後に真っ白になるまで色を変化させてピクチャを削除するというアニメーションに出来ると少しはわかりやすいかなと思ってやってみたものが次のものです。
結構な長さになったのですがこれを実現させるためのVBAは次の通りです。
Dim shp As Object
Dim efcttop As Double
Dim toumei As Double
Range("A" & Target.Row & ":G" & Target.Row).CopyPicture Appearance:=xlScreen, Format:=xlPicture
Application.EnableEvents = False
ActiveSheet.Range("A" & Target.Row).Select
ActiveSheet.Paste
Set shp = Selection
Target.Select
Application.EnableEvents = True
For toumei = 10 To 5 Step -1
shp.ShapeRange.PictureFormat.Brightness = toumei / 10
Application.Wait [Now] + TimeValue("0:0:1") / 10
DoEvents
Next
For efcttop = Target.Row To 4 Step -1
shp.Top = Range("A" & efcttop).Top
Application.Wait [Now] + TimeValue("0:0:1") / 10
DoEvents
Next
For toumei = 1 To 10
shp.ShapeRange.PictureFormat.Brightness = toumei / 10
Application.Wait [Now] + TimeValue("0:0:1") / 10
DoEvents
Next
shp.Delete
Application.EnableEventsは、SelectionChangeイベントの中でまたセルを選択すると SelectionChangeイベントがそこで発動してしまいぐるぐる回ってしまうのでそれを止めるために入れています。なので選択前に無効にして、選択みたいなことを終わらせたら有効にしています。
Application.Wait [Now] + TimeValue(“0:0:1”) / 10は今の時間に対して0.1秒後に動き出してくださいねという待ち時間です。
DoEventsはそのステップに行ったら画面をきちんと更新して欲しいので入れているだけです。アニメーション設定する時はよく使う方法ですね。
Forループで減少方向にループさせていくのでSTEPで-1を指定しています。
変数の型をDoubleにしているのは、将来小数点以下のポイント数で移動させようかと思っているからです。
以上がこのVBAの設計ポイントですね。
本当は一定の速度ではなくてもっと有機的にだんだん早くなっていくとかそういうスピード調整もしたかったんですが微分積分をウェイト時間に入れなきゃいけなくなるのでちょっと面倒なのでやめました。そういうサブルーチンを作れば簡単な気もします。




コメント