今回はVBAでユーザーフォームに配置したボタンの反応が遅い理由とその対策について紹介する。
検証のため、以下のようなカウンターフォームを作った。
作成方法
フォームに配置した各オブジェクトは以下のように名前を変更した。
コードは以下のとおり。
Private Sub cmdCountUp_Click() Me.lblCounter.Caption = CLng(Me.lblCounter.Caption) + 1 End Sub Private Sub cmdReset_Click() Me.lblCounter.Caption = 0 End Sub
課題
ぽちっぽちっと丁寧に押していく分には問題ないのだが、連続して速くクリックしたときに反応が悪い。
↓9クリックしてるのに5しかカウントされてない。
この事象、単にVBAのフォームが遅いためと思い込んでいる方もいるかもしれないが、原因は別のところにある。
試しにCountUpボタンにフォーカスが当たっている状態でスペースキーを連打するとちゃんと連打スピードについてくるのだ。つまりキーでボタンを押した場合は問題ないのに、マウスでクリックした場合は遅いということになる。
原因
原因は、コマンドボタンがダブルクリックイベントを拾っているため。
連続で速くクリックすると、次のように判定される。
- クリック
- ダブルクリック
- クリック
- ダブルクリック
- クリック
- ダブルクリック
つまり、クリック間隔が短いと、偶数回目のクリックがダブルクリック扱いになってしまうため、クリックイベントとしては半分しか判定されないのだ。
対策
この対策は簡単で、単にダブルクリックイベントをキャッチアップしてシングルクリックイベントのプロシージャを呼んでやれば良い。
Private Sub cmdCountUp_Click() Me.lblCounter.Caption = CLng(Me.lblCounter.Caption) + 1 End Sub Private Sub cmdCountUp_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Call cmdCountUp_Click End Sub Private Sub cmdReset_Click() Me.lblCounter.Caption = 0 End Sub
この対策を施した結果がこちら。
ちゃんとクリックした分カウントアップされている。
別の問題
前述の対策は、とても良さそうに思える。
ただし、コマンドボタンの無効化と組み合わせると、ボタンが陥没して戻ってこないという別の問題が多発する。
試しに数値が10に達したらボタンを無効化するようコードを書き換えてみた。
Private Sub cmdCountUp_Click() Me.lblCounter.Caption = CLng(Me.lblCounter.Caption) + 1 If CLng(Me.lblCounter.Caption) >= 10 Then Me.cmdCountUp.Enabled = False End If End Sub Private Sub cmdCountUp_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Call cmdCountUp_Click End Sub Private Sub cmdReset_Click() Me.lblCounter.Caption = 0 Me.cmdCountUp.Enabled = True End Sub
すると、このようにボタンが陥没するようになった。
無効化を解除してもボタンは凹んだままで、クリックすると戻る。
ボタンの陥没は、ダブルクリックイベント時にボタンを無効化すると発生するようで、シングルクリック時は発生しない。
以下は検証の結果。
事象が発生するパターン
- クリック
- ダブルクリック
- クリック
- ダブルクリック
- クリック
- ダブルクリック
- クリック
- ダブルクリック
- クリック
- ダブルクリック ←ここで無効化されるので陥没する
事象が発生しないパターン1
- クリック
- ダブルクリック
- クリック
- ダブルクリック
- クリック
- ダブルクリック
- クリック
- ダブルクリック
- クリックし、次がダブルクリックにならないようしばらく時間を置く。
- クリック ←ここで無効化されるので陥没しない
事象が発生しないパターン2
- クリックし、次がダブルクリックにならないようしばらく時間を置く。
- クリック
- ダブルクリック
- クリック
- ダブルクリック
- クリック
- ダブルクリック
- クリック
- ダブルクリック
- クリック ←ここで無効化されるので陥没しない
ボタン陥没の回避方法(没案)
この事象はフォームのRepaintをしてみたり、DoEventsを挟んでみたりしたけれど改善されなかった。
ということで根本的な解決策は見つかっていない。(あるいは存在しない)
ひょっとするとWinAPIなどで何とかする方法はあるのかもしれないが、少なくともVBA単体では見つからなかった。
今のところ、ボタンの無効化を諦めるか、最後がダブルクリックにならないように回避コードを書くしかなさそうだ。
回避コードとしては以下のように、無効化の一歩手前でダブルクリックイベントからのシングルクリックイベント呼び出しをやめること。
※以下は私が考えた手、古い回避方法です。より良い方法が見つかったので、後述のボタン陥没の回避方法(改)をご覧ください。
Private Sub cmdCountUp_Click() Me.lblCounter.Caption = CLng(Me.lblCounter.Caption) + 1 If CLng(Me.lblCounter.Caption) >= 10 Then Me.cmdCountUp.Enabled = False End If End Sub Private Sub cmdCountUp_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If CLng(Me.lblCounter.Caption) < 9 Then Call cmdCountUp_Click End If End Sub Private Sub cmdReset_Click() Me.lblCounter.Caption = 0 Me.cmdCountUp.Enabled = True End Sub
ただ軽快にカウントアップされて最後だけ1回「スカ」が入るので、イマイチだな。
↓9になるとダブルクリックイベントを無視するので最後だけボタンを2回クリックしている。
ボタン陥没の回避方法(改)
imihitoさんにTwitterで回避方法を教えていただきました。ありがとうございます!
ボタン陥没はダブルクリックイベントの所に
— いみひと (@nukie_53) 2017年12月7日
`Cancel.Value = (CLng(Me.lblCounter.Caption) >= 9)`
を入れると良さげですね
ということで、早速試してみた。
Private Sub cmdCountUp_Click() Me.lblCounter.Caption = CLng(Me.lblCounter.Caption) + 1 If CLng(Me.lblCounter.Caption) >= 10 Then Me.cmdCountUp.Enabled = False End If End Sub Private Sub cmdCountUp_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Call cmdCountUp_Click Cancel.Value = (CLng(Me.lblCounter.Caption) >= 9) End Sub Private Sub cmdReset_Click() Me.lblCounter.Caption = 0 Me.cmdCountUp.Enabled = True End Sub
ふむふむ、これで意図したとおりに動作している。
あれ、ちょっとまてよ。
ということは、ダブルクリックイベント自体はキャンセルしても、Call cmdCountUp_Clickで呼び出しは成功している?
であれば、単にCancel = Trueで良さげ。
ボタン陥没の回避方法(最終案)→没案
ということで最終的に完成したコードがこちら。
…と思ったけれど、無条件でキャンセルすると環境によってはボタンクリックした際の描画がおかしいらしい。
Office2016 64ビット版でカウントアップはされるがボタンクリック動作が遅れて見えるとのこと。
ひょっとすると、マシンスピードが速すぎるとクリックイベントでの描画が完了する前にダブルクリックイベントのキャンセルまで実行されてしまって描画が発生しないのかもしれない。
当方の環境で描画がおかしくなることはなかったが、以下の案は没案とし、推奨は「ボタン陥没の回避方法(改)」で紹介した条件付きCancelとしたい。
Private Sub cmdCountUp_Click() Me.lblCounter.Caption = CLng(Me.lblCounter.Caption) + 1 If CLng(Me.lblCounter.Caption) >= 10 Then Me.cmdCountUp.Enabled = False End If End Sub Private Sub cmdCountUp_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Call cmdCountUp_Click Cancel = True '←無条件キャンセル。良いと思ったけれど環境依存の可能性が報告されたため没。 End Sub Private Sub cmdReset_Click() Me.lblCounter.Caption = 0 Me.cmdCountUp.Enabled = True End Sub
あとがき(2017/12/9に執筆)
さて、今回の記事でボタン単品を連打する必要性に疑問を持たれた方もいると思うけれど、私が実際に作りたかったのはこちら↓
ページめくり処理でもっさりしてストレスになったので今回記事にした。
今回のテクニック+諸々を使って、実際に作成したのでクラスモジュール上級者は、こちらも併せてどうぞ。
thom.hateblo.jp