【VBA】ユーザーフォームのボタン長押しで処理を実行する

こんにちは、Ryoです。
VBAの処理実行の際によく使うコマンドボタンですが、1クリック毎の操作だと処理内容によっては煩わしいこともあり、押したままの状態で押されている間は処理を実行し、離せば止まるという形が出来たら良いなと思うことありませんか?

今回はユーザーフォーム上のボタン押しっぱなしの状態を判別し、押されている間は処理を行い、離せば停止する方法についてサンプルを主体に書いてみたいと思います。



1.サンプル①

◆概要

先ずサンプル①として、以下画像のシンプルなUserForm1を作り、フォーム上のCommandButton1を長押ししてる間は、セルA1に1ずつ連続して数値を加算します。

このCommandButton1を押している間は加算を続け、離せば止まります。
もちろん、1クリックなら1加算して止まるので通常の使い方もOKです。

◆サンプルコード

UserForm1は至ってシンプルですから敢えて解説しませんが大丈夫ですよね。
簡単に書いておくとエディタから「挿入」→「ユーザーフォーム」を選び、その上にツールボックスから「コマンドボタン」を貼り付ければOKです。

そしてUserForm1側に以下のコードを記述します。

Private mDownEOT As Double  'ボタン長押し有効時間
'----------------------------------------------
Private Sub mDown()

    mDownEOT = nTime() + 600  'ボタン長押し有効時間の設定
    
    Do Until mDownEOT < nTime() Or mDownEOT = 0 
            '安定動作の為に必要         
            DoEvents 
            'MouseUpしない間、処理の実行 
            If mDownEOT > 0 Then  
              Call Test1
            End If
    Loop
    
    mDownEOT = 0

End Sub
'-----------------------------------------------
Private Function nTime() As Double

    nTime = CDbl(Timer)

End Function
'-----------------------------------------------
Private Sub mUp()
    
    mDownEOT = 0

End Sub
'-----------------------------------------------
Private Sub CommandButton1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  
  Call mDown

End Sub
'------------------------------------------------
Private Sub CommandButton1_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  
  Call mUp

End Sub

ボタンを長押しした状態、及び離した状態をコントロールするにはMouseUp,MouseDownを使います。この部分はエディタ上でCommandButton1と、

MouseUpやMouseDownを選べば、

このように自動的に生成してくれます。

ここで何をしているかを簡単に説明すると、上述のMouseDown(押された状態)が発生した時とMouseUp(離した時)の処理を記述しています。

先ず共有する変数としてPrivate mDownEOT As Doubleを宣言しますが、これは長押しの有効時間設定と離した時の判定に使っています。

mDown()は押された状態の処理ですが、Timer関数で得た数値を倍精度浮動小数点型に置換して取得し、そこに加算している600は「秒数」になります。

「600」は10分なので、さすがにそこまで押し続ける人はいないでしょうから大丈夫だと思いますが、理由があって数秒で長押しを終了したければ短くしても良いと思います。

後はTimer関数で取得した数値とmDownEOT = nTime() + 600とした数値の差を見て、同等か0にならない限り、処理を実行します。途中で離せばMouseUpが実行され、mDownEOTが0となり処理が終了します。

このサンプルではCall Test1の部分が繰り返し実行する部分になります。
以下のコードは標準モジュール側に記述します。

Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
'-------------------------------------------------------------------
Sub Test1()
     Cells(1, 1).Value = Cells(1, 1).Value + 1
     Sleep 300   'スピード調整用
     DoEvents
End Sub

押した状態を維持した時に連続で実行されますので、そのまま処理すると猛烈なスピードで表示が変わっていきますから困りますよね。その為、Sleepを使って連続して表示されるスピードを調節します。

Sleep 300で0.3秒ですが、個人的にはこのぐらいが丁度良いと思ってます。
これでUseForm1を呼び出しでコマンドボタンを押せば、セルA1にボタンを押している間は連続して加算されていき、離せば止まるようになっています。

2.サンプル②

これはサンプル①を応用して、実際の運用時に使えそうなサンプルとして作ってみました。
動作としては、ユーザーフォームをアクティブ(呼び出し)した際にデータファイルを開いて読み込み、そのデータを順送り/逆送りでフォーム上の表示を変化させるものです。

「Fwd≫」で取得したデータの順送り、「≪Rev」で逆送りとしますが、読んだデータはLabel1に表示され、当然ながらボタンを押している間は連続してデータが切り替わっていきます。

◆サンプルコード

こちらはUserForm2になります。
使うのはCommandButton1(≪ Rev)、CommandButton2(Fwd  ≫)、CommandButton3(閉じる)、Label1(データ表示)としていますが、ボタン1と2のCaptionはコード内で判別に使っていますので、ご注意くださいね。

それ以外はフォントや文字色を変更してるぐらいなので、お好みでOKです。

Private mDownEOT As Double  'ボタン長押し有効時間
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Public SampleDat As Variant
Public Fcnt, LastRow, LastCol As Long
'----------------------------------------------
Private Sub UserForm_Activate()
 
  '元データファイルを読み取り専用で開く
  Workbooks.Open Filename:=ThisWorkbook.Path & "\Data_Sample.xlsx", ReadOnly:=True

  'データ入力の最終行、最終列を取得
  LastRow = Cells(Rows.Count, 1).End(xlUp).Row
  LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

  '本サンプルでは使用範囲を全て配列に格納する
  SampleDat = ActiveSheet.UsedRange
  '読み込み後、ブックを閉じる
  ActiveWorkbook.Close

End Sub
'-------------------------------------------------
Private Sub CommandButton1_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  'ボタン1に対するマウスアップ処理
  Call mUp
End Sub
'-------------------------------------------------
Private Sub CommandButton2_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  'ボタン2に対するマウスアップ処理
  Call mUp
End Sub
'-------------------------------------------------
Private Sub CommandButton1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  'ボタン1に対するマウスダウン処理
  Call mDown
End Sub
'--------------------------------------------------
Private Sub CommandButton2_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  'ボタン2に対するマウスダウン処理
  Call mDown
End Sub
'--------------------------------------------------
Private Sub mDown()

   Dim Btn_Name, Dstr As String

   mDownEOT = nTime() + 600  'ボタン長押し有効時間の設定
   If Fcnt = 0 Then Fcnt = 1
    
    Do Until mDownEOT < nTime() Or mDownEOT = 0         
       '無くても動作するが記述した方が安定         
             DoEvents        
            'MouseUpしない間、処理の実行  
            If mDownEOT > 0 Then  
            'フォーム上の押したボタン名を取得する
            Btn_Name = UserForm2.ActiveControl.Caption
            Select Case Btn_Name
               '順送りでの処理
                Case Is = "Fwd ≫"
                   Fcnt = Fcnt + 1
                   If Fcnt > LastRow Then Fcnt = 2
                   Call Num
               '逆送りでの処理
                Case Is = "≪ Rev"
                   Fcnt = Fcnt - 1
                   If Fcnt = 1 Then Fcnt = LastRow
                   Call Num
             End Select
         End If
     Loop
    
    mDownEOT = 0

End Sub
'---------------------------------------------------
Private Function nTime() As Double

    'Timer関数を使い、倍精度浮動小数点型で取得
    nTime = CDbl(Timer)

End Function
'--------------------------------------------------
Private Sub mUp()

   'マウスアップ(ボタンを離す)での処理
    mDownEOT = 0

End Sub
'--------------------------------------------------
Private Sub Num() '配列データの順/逆送りと表示

  Dim Dstr As String
  Dstr = "SN:"

  For i = 1 To LastCol
     '配列データをDstrに文字連結
     Dstr = Dstr & SampleDat(Fcnt, i) & "/"
  Next i
                    
  Me.Label1.Caption = Dstr
  Sleep 300   'スピード調整用
  DoEvents
                
End Sub
'-------------------------------------------------
Private Sub CommandButton3_Click()

 '配列データのクリア
 Erase SampleDat
 '順/逆送りカウンタ変数クリア
 Fcnt = 0
 LastRow =0
 LastCol = 0
 'フォームを閉じる
 Unload UserForm2

End Sub

先ず上から順に簡単に説明しますと、ボタン長押し時間やSleepは同じです。
後は読み込んだデータ用のSampleDat、順/逆送り時に現在表示と合わせる為のFcnt、読み込んだ元データの最終入力行LastRow、最終入力列LastColを共有の変数として宣言します。

先ずはPrivate Sub UserForm_Activate()でフォームが表示された際に指定パスのファイルを開き、最終入力行と列を抽出してデータを配列に格納し閉じます。
データファイルは例として以下の様になっています。

その下はCommandButton1とCommandButton2に対してMouseUpとMouseDownの処理を記述していますが、ここもサンプル①同様です。

そしてPrivate Sub mDown()で押された時の処理をしますが、概ねサンプル①と同様なものの、順/逆送りどちらのボタンを押したか判定させないといけませんので、

  Btn_Name = UserForm2.ActiveControl.Caption
            Select Case Btn_Name
               '順送りでの処理
                Case Is = "Fwd ≫"
                   Fcnt = Fcnt + 1
                   If Fcnt > LastRow Then Fcnt = 2
                   Call Num
               '逆送りでの処理
                Case Is = "≪ Rev"
                   Fcnt = Fcnt - 1
                   If Fcnt = 1 Then Fcnt = LastRow
                   Call Num
             End Select

この中のUserForm2.ActiveControl.Captionで押されたボタンのCaption情報を取得し、Select Caseで判定させています。これは知ってると何かと役に立つのでお薦めですね。

その後、判定された方向に準じて共有変数のFcntを加算/減算しながらCall Num()を実行して、読み込んだデータを文字として連結しLabel1に表示しますが、表示後にサンプル①同様Sleepを入れておきます。

後はTimer関数やマウスアップ時の処理は同様で、閉じるボタン(CommandButton3)を押した際には配列や変数の値をクリアしてフォームを閉じます。

3.まとめ

動作などの詳細な解説は割愛してますのでわかりにくい部分もあるかもしれませんが、実際に処理を実行してみると直ぐに理解できると思います。
このようにボタンを長押ししてる間に処理を実行する方法もありますから、実際の運用上では知っておくと使える場面が多々ありますので、機会があればご検討くださいませ。




以上、ユーザーフォームのボタン長押しで処理を実行する方法についてでした!
長くなってしまいましたね。。。
今回の記事が何かの参考になれば幸いです。

Ryo

スポンサーリンク
スポンサーリンク

楽天トラベル

シェアする

フォローする

スポンサーリンク

楽天トラベル