【 2016年9月15日  サイト 移転のお知らせ 】
      AddinBox サイトを [ DION ] から [ さくら インターネット ] へ移転しました。  なお、旧サイト は 2017年10月 まで残します。
      この ページ の 移転先 URL  ⇒⇒  http://addinbox.sakura.ne.jp/Excel_Tips15.htm  
 
ロゴ(青) Excel/VBA Tips ロゴ(緑)

Tips15: VBAでも出来る [ タイマーコントロール ] クラスモジュール  (Ver 3.1) 

(注) 2005/11/25 公開の版 (Ver 1, MOUGでの公開版) とは、仕様/インターフェースが異なっています。
( Ver 3.0 で x64 対応となりました )


Ver 3.1 で 7セグメント時計
サンプルを追加しました。

  VBでは「ある時間経過後にイベントを発生」させる『タイマーコントロール』というものが
利用できますが、残念ながら VBAではサポートされていません。
  したがって、VBAで待機処理させる場合には OnTime メソッド や Wait メソッド、または
API の Sleep 関数を使う事になります。Wait メソッドと Sleep 関数ではVBA処理そのもの
を停止させますので、待機中に平行して別の処理を行なう事はできません。OnTime メソッ
ドの場合には待機中に平行して別の処理が行なえますが単発機能ですので、繰り返し
待機処理させる場合には、待機から戻ってきた時点で再度OnTime メソッドを実行するとい
う処理になります。タイマーコントロールならば、指定時間経過の時点でタイマーイベントル
ーチンをシステム側が自動的に起動させるまでの間、ユーザーサイドで他の処理を実行す
る事が可能ですし、タイマーを停止させるまでは時間経過の都度、繰り返して処理されます。
  タイマーコントロールがあれば簡単に出来るのに VBA では実現できなかった一例として
は、UserForm上にリアルタイムで時を刻む『時計』を配置しつつテキストボックスやコマンド
ボタン等のユーザー操作のイベント処理も行なう、ユーザー操作を行ないつつ一定の時間
経過時点でMsgBox を表示する、といったものがあるでしょう。

  ここで紹介するのは、MOUG/VBA掲示板において「平さん」が提示したクラスモジュール
を利用してタイマーコントロールを実現するコードを、私が改良/汎用化させたものです。

【 注 意 事 項 (必ずお読み下さい) 】

  以下のプログラムでは 『 コールバック 』 と呼ばれる手法を利用しています。エクセルでは、コールバックで呼ばれた処理の中で「実行時エラー」が発生し中断するとクラッシュする可能性があります。その結果として、ブック破損や未保存情報の喪失(開発中のプログラムやシート上の様々なデータ)が起こる可能性があります。また、コールバックで呼ばれる処理の起動タイミングが 「シート編集作業中」にぶつかると、やはりクラッシュする可能性があります。

  以上の事から、このプログラムを利用する場合には、
    (1) モーダルフォーム内での利用に限る(モードレスフォーム、シートやThisWorkbook
        モジュール、標準モジュールからのタイマー起動は避ける)。つまり、シートの操作が出
        来る状況では使用しないという事です(モーダルフォームであれば、フォーム表示中は
        シート等の操作は出来ません)。これは必ず厳守してください。
        (Ver 2 では、UserForm以外での利用は出来ない仕様になりました)
    (2) タイマーイベント内で行なう処理では「実行時エラー」 によって中断する事がないよ
        うに充分注意を払って設計/プログラミングを行なう。
    (3) テスト中には、実行前に「保存」 を行ない、またタイマーイベント内の処理を最初か
        らタイマー連動でテストするような事はせず、単独でテストし、「実行エラー」 などの
        バグを事前に確実に取り除く。
といった注意が必要です。

  なお、このプログラムでは、コールバックで即 [ RaiseEvent メソッド ] によるイベントへ繋げています。つまり、ユーザーサイドの処理は VBA システムが介在した後のイベントルーチン内で行なわれるものです。したがって、コールバックで直接呼ばれたルーチン内で行なわれるものとは多少扱いが異なるかもしれませんが、確たる保証がありませんので、通常のコールバック処理と同じ注意が必要です。

  また、他の大事なブックを開いたままで 「ちょっと、この機能、面白そうだから試してみるか」と安易に試さないでください。大事なブックが失われてしまうかもしれません。

  何れにして、以下のプログラムの利用に際しては、
      仕組みを充分に理解した上で 『 自己責任 』 において
行なってください。
 


(利用方法)
  1.下記のサンプルブックをダウンロードして、クラスモジュール[ clsTimer ] と標準
      モジュール[ TimerModule ] の2つを各自のブックにインポートしてください。
            サンプルブック( TimerControl_V31.zip  70KB )    (2012/3/18 Ver3.1)
                    2005/11/25  Ver1.0  moug で回答したマクロです。
                    2005/11/27  Ver2.0  AddinBox 公開に際して、仕様/インターフェースを変更しました。
                    2011/ 9/27  Ver3.0  Win32-API 処理に [ x64 ] 対応の修正を行ないました。
                    2012/ 3/18  Ver3.1  利用サンプル に 【 7セグメント デジタル時計 】 を追加しました。
                                               clsTimer クラス に変更はありません。



====================================================================
    [ clsTimer ] クラス リファレンス    (2011/ 9/27 Ver 3.0 )
====================================================================
  RaiseEvent ステートメント 並びに AddressOf 演算子 を使用していますので、このクラスは
  『Excel2000 以上』でのみ利用できます (Excel97 では利用できません)。
  このクラスは UserForm モジュールでのみ利用できます。


      下記で[ object ]の部分には、clsTimer クラスを定義したオブジェクト変数を記述します。
定  義
タイマーを使用するUserForm モジュールの宣言セクション(モジュールの先頭)で、下記のように定義
します。尚、その UserForm は必ずモーダルモードで表示してください。モードレスでの利用は障害
を伴う可能性があります。

    Private  WithEvents  object  As  clsTimer

    ( object )
      任意の名前を指定して下さい。

    タイマー実行に先立ち (Initialize イベント等 )、下記のようにしてクラスのインスタンスを作成します。
        Set  object  =  New  clsTimer

    また、UserForm を閉じる前 (QueryClose イベント等 ) には、下記のようにしてタイマーの停止 および
    クラスインスタンスの解放を行ってください。
    残っている(未停止の)タイマーの数は Count プロパティで取得できますが、未停止タイマーの有無に
    係わらず、無条件で下記を実行するようにしてください。

        object .DestroyAll
        Set  object  =  Nothing


メソッド
object .Create    Caller , TimerID , Interval

    指定した時間間隔のタイマーを起動します。

    ( Caller )
      タイマー処理を組み込む UserForm を指定します。実際には 「Me キーワード」 を指定します。

    ( TimerID )
      任意の 「1 以上 」 の数値を指定します。複数のタイマーを使用する場合は重複しない番号を割振って
      ください。なお、この番号はUserForm 単位で管理していますので、UserForm が異なれば同時実行で
      あっても同じ番号を割り当てても構いません。

      ここで指定した番号が タイマーイベントで通知されますので、複数のタイマーを使用する場合には、その
      番号で処理を振り分けてください。

    ( Interval )
      タイマーイベントの間隔を 『 秒 』 単位で指定します。1秒間ならば 1 を指定します。
 

object .Destroy    TimerID , [ OtherHWnd ]

    指定した ID のタイマーを停止します。

    同時に、タイマー情報を格納したコレクションから、この ID に関する登録情報を削除します。コレクションが
    空になった時点で自動的に 「コレクションオブジェクト」 が解放されますので、ユーザーサイドでコレクション
    オブジェクトの解放に気を使う必要はありません。以下に説明しているように 「停止忘れ」 が無いように注
    意していれば充分です。

    このタイマーを利用するプログラムが終了する際 ( UserForm を閉じる際など ) には、必ず、使用した ID に
    対して Destroy メソッドを実行してタイマーを停止させてください。停止中の ID に対して Destroy メソッドを
    実行しても問題ありませんので、終了時には使用した全ての ID に対して無条件に実行する事をお薦めしま
    す(次の DestroyAll メソッドでも構いません)。

    ( TimerID )
      Create メソッドで指定した TimerID を指定します。

    ( OtherHWnd )    Ver3.0 〜
      ユーザーサイドでは 常に省略してください。 (DestroyAll 用のインターフェースです)

      省略すると、自UserForm 発行のタイマーが対象になります。
      値を指定した場合は、[ その値を Hwnd に持つ UserForm ] が発行したタイマーが対象になります。


  この Destroy メソッドによって、全て (自UserForm/他UserForm 含めて) のタイマーが破棄された
      (稼働中タイマーが全く無い) 場合には、TimerModule にある colClsTimer コレクションオブジェ
      クト も合わせて破棄 (Nothing の設定) されます。
      ユーザーサイドでは、Destroy / DestroyAll メソッド の実行を確実に行っておけば、TimerModule に
      ある colClsTimer コレクションオブジェクト に意識を払う必要はありません。


object .DestroyAll    [ OtherForm ]

    稼働中の全てのタイマーを 一括して停止/破棄します。
    UserForm を閉じる際 ( QueryClose 等 ) に実行してタイマーの停止漏れが無いようにしてください。

    ( OtherForm )    Ver3.0 〜
        False or 省略 : 自UserForm で発行したタイマーのみを一括で停止/破棄します。
                            他UserForm で発行しているタイマーには影響しません。

        True            : 他UserForm が発行したタイマーも含めて、全てのタイマーを一括で停止/破棄します。
                            親UserForm の終了時に、 安全策として、子UserForm 発行のタイマー分も一緒に停止
                            /破棄しておくといった使い方で利用します。


  この DestroyAll メソッドによって、全て (自UserForm/他UserForm 含めて) のタイマーが破棄された
      (稼働中タイマーが全く無い) 場合には、TimerModule にある colClsTimer コレクションオブジェ
      クト も合わせて破棄 (Nothing の設定) されます。
      ユーザーサイドでは、Destroy / DestroyAll メソッド の実行を確実に行っておけば、TimerModule に
      ある colClsTimer コレクションオブジェクト に意識を払う必要はありません。
 

プロパティ
object .Count    ( [ AllTimer ] )  [ = Long ]         Ver 3.0 〜

    登録されている (稼働中の) タイマーの数を返します。
    値の取得のみ可能です。

    ( AllTimer )
      True または False を指定します。 省略すると False と見做します。

    ( 値の取得 )
      AllTimer に指定した値によって、下記の値を返します。

      True            : 全て ( 他の UserForm で発行したものを含む ) の稼働中のタイマーの数を返します。
      False or 省略 : 自UserForm で発行した稼働中のタイマーの数を返します。      
 

イベント
Private Sub object_Tick ( ByVal TimerID As Long )

    タイマー発行時に指定された時間間隔で発生します。複数のタイマーを処理している場合は、TimerID の
    内容によって、対応するタイマー処理へ振り分けて下さい。

    ( TimerID )
      Create メソッドで指定した TimerID の値が返ります。

    『注意』  ( このページ先頭の赤色の注意事項も熟読の事 )
      このイベントルーチン内で行なう処理では 【実行時エラー】 が発生しないように充分に留意して下さい。
      検索やチェック処理などでは、実行時エラーの発生が避けられないものもあります。そのような場合には、
      [ On Error Resume Next ] などのエラー処理を確実に施すように留意して下さい

      サンプルコードのように、UserForm の時計ラベル表示のみといった単純な処理ならばタイマーをそのまま
      継続していても構いませんが、
          ・ 多少時間を要する (タイマー間隔を超えるような)
          ・ エラーが発生する可能性がある
          ・ ブック・シートへの操作(セルへの書き出し 等) を行なう
      といった処理の場合には、このイベントルーチンに入った際に
          一端 『 Destroy メソッド で タイマー停止』
      してから処理を行ない、イベントルーチンを抜ける際に
          再度 『 Create メソッド で タイマー発行』
      するようにしてください。

 



====================================================================
    タイマーコントロール クラス の利用例 
====================================================================
  RaiseEvent ステートメント 並びに AddressOf 演算子 を使用していますので、このクラスは
  『Excel2000 以上』でのみ利用できます (Excel97 では利用できません)。
  このクラスは UserForm モジュールでのみ利用できます。

  サンプルブック に収録してある テストマクロ と ほぼ同じものですが、サンプルブックの方がエラー処理を
  しっかり行なっていますので、実際にはサンプルブックの方のマクロを利用してください。

  下記のコードは、UserForm上にデジタル時計を表示するサンプルです。複数のタイマー
が個別に動作している事を確認できるように、「1秒間隔」と「3秒間隔」で現在時刻をラベル
とセルに表示します。また、「10秒後」に自動的(ユーザー操作中でも)にMsgBox を表示し
ます。
  UserForm に、コマンドボタンを5つ(CommandButton1〜5)、ラベルを2つ(Label1〜2)、
テキストボックスを適当(ユーザー入力操作中でのデモの為)に配置して下記コードをコピー
して下さい。更に後述の「タイマーコントロールのソースコード( TimerModule, clsTimer )」
を標準モジュール/クラスモジュールに追加します。
  ユーザーフォーム表示後に、ボタン1〜4で下記のデモが行なえます。
      ・ボタン1をクリックすると1秒間隔のタイマーが起動し、1秒間隔で現在時刻が
        Label1 に リアルタイムで表示されます(普通にデジタル時計)。
      ・ボタン2をクリックすると3秒間隔で現在時刻が Label2 に表示されます。
      ・ボタン3をクリックすると10秒経過のタイミングで自動的に MsgBox が表示さ
        れます(これは、その都度タイマーを停止してますので、繰り返し試す場合は
        再度ボタン3をクリックします)。
      ・ボタン4をクリックすると1秒間隔で現在時刻が A1セル に表示されます。
4つのタイマーは平行して起動させる事が可能です。タイマーを停止する場合はボタン5を
クリックします。一度停止させた後、再度起動する事も可能です。

======= サンプルフォーム UserForm1 =======

 Private WithEvents Timer1 As clsTimer    ' タイマーのクラスオブジェクト

 Private Sub UserForm_Initialize ( )
   Set Timer1 = New clsTimer    ' インスタンスの生成
 End Sub

 Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
   ' 後始末
   Timer1.DestroyAll
   Set Timer1 = Nothing
 End Sub

 Private Sub Timer1_Tick (ByVal TimerID As Long)    ' タイマーイベント
   Select Case TimerID
     Case 1
       Label1.Caption = Format(Now, "h:mm:ss")
     Case 2
       Label2.Caption = Format(Now, "h:mm:ss")
     Case 3
       Timer1.Destroy 3
       MsgBox "10秒経過しました"
     Case 4
       'セル書き出しの場合、安全の為に一端タイマーを停止する
       Timer1.Destroy 4
       Worksheets("Sheet1").Range("A1").Value = Format(Now, "h:mm:ss")
       Timer1.Create Me, 4, 1
   End Select
 End Sub

 Private Sub CommandButton1_Click ( )
   '1秒間隔タイマー(Label 表示)を1番で登録/開始
   Timer1.Create Me, 1, 1
 End Sub

 Private Sub CommandButton2_Click ( )
   '3秒間隔タイマー(Label 表示)を2番で登録/開始
   Timer1.Create Me, 2, 3
 End Sub

 Private Sub CommandButton3_Click ( )
   '10秒間隔タイマー(MsgBox )を3番で登録/開始
   Timer1.Create Me, 3, 10
 End Sub

 Private Sub CommandButton4_Click ( )
   '1秒間隔タイマー(セル書き出し)を4番で登録/開始
   Timer1.Create Me, 4, 1
 End Sub

 Private Sub CommandButton5_Click ( )
   'タイマー停止(4つとも)
   Timer1.Destroy 1
   Timer1.Destroy 2
   Timer1.Destroy 3
   Timer1.Destroy 4
 'または
 ' Timer1.DestroyAll
 End Sub



========================================================================
    タイマーコントロール クラス のソースコード
    (下記マクロは x64 対応前の Ver 2.0 です。x64 対応の Ver 3.0 はサンプルブックを参照して下さい。)
========================================================================
  RaiseEvent ステートメント 並びに AddressOf 演算子 を使用していますので、このクラスは
  『Excel2000 以上』でのみ利用できます (Excel97 では利用できません)。
  このクラス は UserForm モジュールでのみ利用できます。


  このクラスを利用する場合は、下記の標準モジュール『 TimerModule 』とクラスモジュー
ル『 clsTimer 』の2つをコピーして下さい(モジュールの名前は変えないで下さい)。なお、
利用に際し、両モジュールとも内容は一切変更する必要はありません。
  複数のUserForm から利用する場合であっても、『TimerModule 』はひとつのみです。ひと
つの『TimerModule 』で全てのUserForm からのタイマーを管理/処理します。

  恐れ入りますが、「VBE でモジュールの追加が判らない」 「クラスモジュールとは何ですか?」 といったレベル
の方はトラブルの元ですから絶対に利用しないで下さい。VBA の知識を十二分に習得し、ここで掲載している
コードを独力で読解できるようになってからにして下さい。


このマクロは x64 対応前の Ver 2.0 です。

======= 標準モジュール 【 TimerModule 】 =======

 'タイマー情報
 ' Key: "TA" & Hwnd & "@" & ID, Data: clsTimerオブジェクト
 ' Key: "TB" & Hwnd & "@" & ID, Data: Hwnd & "@" & ID

 Public colClsTimer As Collection

 Public Sub TimerEvent (ByVal Hwnd As Long, ByVal uMsg As Long, _
                    ByVal IDEvent As Long, ByVal dwTime As Long)
 Dim i As Integer
 Dim objTimer As clsTimer

   If (colClsTimer Is Nothing) Then
       Exit Sub      'タイマー登録情報なし
   End If

   On Error Resume Next
   Set objTimer = Nothing
   Set objTimer = colClsTimer.Item ("TA" & CStr(Hwnd) & "@" & CStr(IDEvent))
   On Error GoTo 0
   If (objTimer Is Nothing) Then
       '指定IDのタイマー未登録
   Else
       objTimer.RaiseTick  IDEvent    'タイマーイベント励起
   End If
   Set objTimer = Nothing
 End Sub



このマクロは x64 対応前の Ver 2.0 です。

======= クラスモジュール 【 clsTimer 】 =======

 Private Declare Function SetTimer Lib "user32" _
      (ByVal Hwnd As Long, ByVal nIDEvent As Long, _
       ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
 Private Declare Sub KillTimer Lib "user32" _
      (ByVal Hwnd As Long, ByVal nIDEvent As Long)
 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
      (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

 Public Event Tick(ByVal TimerID As Long)    'タイマーイベント
 Private MyHwnd As Long    '呼び元 UserForm のHwnd

 '【初期化処理】
 Private Sub Class_Initialize ( )
   MyHwnd = -1    'Hwndの未設定状態
 End Sub

 '【終了処理】
 Private Sub Class_Terminate ( )
 'クラス解放時に停止忘れのタイマーが残っていないかを確認し、
 '残っていれば停止する(自Hwndのみ)。

   Me.DestroyAll
 End Sub

 '【タイマーイベント励起】
 Public Sub RaiseTick(ByVal TimerID As Long)
   RaiseEvent Tick(TimerID)
 End Sub

 '【タイマーの登録&スタート】
 ' Caller  : 呼び元のUserForm
 ' TimerID : 任意の数値
 ' Interval: タイマー間隔を秒単位で指定

 Public Sub Create(ByVal Caller As MSForms.UserForm, _
                 ByVal TimerID As Long, ByVal Interval As Long)
 Dim strKey As String
   If (Caller Is Nothing) Or _
       (TimerID <= 0) Or (Interval <= 0) Then
     Exit Sub
   End If

   If (MyHwnd <= 0) Then
     '初回なので、呼び元UserFormのHwndを取得&保存
     MyHwnd = FindWindow("ThunderDFrame", Caller.Caption)
   End If

 'TimerID 重複/2重起動に備えて、そのTimerIDのタイマーを停止
 '停止処理の中でコレクション情報も削除される

   Me.Destroy TimerID

 'タイマーが全く未起動の場合はコレクションのインスタンスも未生成
   If (TimerModule.colClsTimer Is Nothing) Then
     Set TimerModule.colClsTimer = New Collection
   End If

 'タイマー管理情報の登録
   strKey = CStr(MyHwnd) & "@" & CStr(TimerID)
   With TimerModule.colClsTimer
     .Add Item:=Me, Key:="TA" & strKey
     .Add Item:=strKey, Key:="TB" & strKey
   End With
 'タイマー起動
   SetTimer MyHwnd, TimerID, (Interval * 1000), _
               AddressOf TimerModule.TimerEvent
 End Sub

 '【タイマーの停止】
 Public Sub Destroy(ByVal TimerID As Long)
 Dim objTimer As Object
 Dim strKey As String
   If (MyHwnd <= 0) Or (TimerID <= 0) Then
     Exit Sub
   End If

   If (TimerModule.colClsTimer Is Nothing) Then
     Exit Sub    'タイマー登録なし
   End If

   strKey = CStr(MyHwnd) & "@" & CStr(TimerID)
   On Error Resume Next
   Set objTimer = Nothing
   Set objTimer = TimerModule.colClsTimer.Item("TA" & strKey)
   On Error GoTo 0
   If (objTimer Is Nothing) Then
     Exit Sub    '指定IDのタイマー未登録
   End If

 '指定タイマーの停止
   KillTimer MyHwnd, TimerID

 'タイマー管理情報の削除
   With TimerModule.colClsTimer
     .Remove "TA" & strKey
     .Remove "TB" & strKey
   End With

   If (TimerModule.colClsTimer.Count = 0) Then
     'タイマー全解放により管理情報コレクションも解放
     Set TimerModule.colClsTimer = Nothing
   End If
 End Sub

 '【全タイマーの停止(自Hwndのみ)】
 Public Sub DestroyAll()
 Dim vntItem As Variant
 Dim strHwnd As String
 Dim lngTimerID() As Long
 Dim i As Integer
   If (TimerModule.colClsTimer Is Nothing) Then
     Exit Sub
   ElseIf (TimerModule.colClsTimer.Count = 0) Then
     Set TimerModule.colClsTimer = Nothing
     Exit Sub
   End If
   If (MyHwnd <= 0) Then
     Exit Sub
   End If

   strHwnd = CStr(MyHwnd) & "@"
   ReDim lngTimerID(1 To TimerModule.colClsTimer.Count)
   i = 0
   For Each vntItem In TimerModule.colClsTimer
     '[TA:Object(clsTimer) , TB:String]
     If (VarType(vntItem) = vbString) Then
       If (Left(vntItem, Len(strHwnd)) = strHwnd) Then
         i = i + 1
         lngTimerID(i) = Val(Mid(vntItem, Len(strHwnd) + 1))
       End If
     End If
   Next vntItem
   For i = 1 To UBound(lngTimerID)
     If (lngTimerID(i) > 0) Then
       Me.Destroy lngTimerID(i)
     End If
   Next i
 'タイマー全解放時の「管理情報コレクション解放」はDestroy内で行なわれる
 End Sub








[ この場所へのリンク ]
====================================================================
    [ clsDec7Seg ] クラス リファレンス / 利用例    (2012/ 3/18 Ver 3.1 で収録)
====================================================================


      下記で[ object ]の部分には、clsDec7Seg クラスを定義したオブジェクト変数を記述します。
定  義
[ 7 セグメント数字 ] を使用するUserForm モジュールの宣言セクション(モジュールの先頭)で、下記の
ように定義します。

    Private  object  As  clsDec7Seg

    ( object )
      任意の名前を指定して下さい。

    クラスの実行に先立ち (Initialize イベント等 )、下記のようにしてクラスのインスタンスを作成します。
        Set  object  =  New  clsDec7Seg

    UserForm を閉じる前 (QueryClose イベント等 ) には、下記のようにしてクラスインスタンスの解放を
    行ってください。
        Set  object  =  Nothing
        または  Erase  object     (object が 配列 の場合)



1数字分(7個のラベル)で 1 クラスオブジェクト を構成します。
上記の デジタル時計の場合には 6個の クラスオブジェクトになります。

各ラベルのコントロール名は [ プリフィックス + セグメント番号 ] とします。
セグメント番号の並びは 左図 の通りです。
(例)  lblSeg_1 , lblSeg_2 , ……
        lblSeg_11 , lblSeg_12 , ……


    7 セグメントに使用するラベルコントロール群は、サンプルブックの UserForm4 から コピーして利用
    してください。


メソッド
object .Rgst    Owner , Prefix

    7 個のラベルを 1数字分として登録します。

    ( Owner )
      7セグメント数字を組み込む UserForm を指定します。実際には 「Me キーワード」 を指定します。

    ( Prefix )
      7 セグメント数字を構成する [ 7個の ラベルコントロール ] の プリフィックス名を文字列で指定します。

    Rgst メソッド内で [ プリフィックス + (1 〜 7) ] のコントロール名のラベルコントロールを登録します。

    コントロールが 7個 揃って存在していない場合には Rgst メソッドは失敗し(実行時エラーにはなりません。
    無視するだけです)、Value プロパティ に値を指定しても反応しません。
 

プロパティ
object .Value    Value  [ = Integer ]

    指定の 数字 を表すパターンで 7 セグメント の表示を切り替えます。

    ( Value )
      表示する 数値 を指定します。

    ( 値の設定 )
      0 〜 9 の値を指定します。
      上記以外( -1 等 ) を指定すると、7セグメント全てを消灯します。
 


下記サンプル および clsDec7Seg クラス は、サンプルブックに収録されています。
このサンプルでは デジタル時計を実装しますので、一緒にタイマーコントロールクラス(clsTimer)
を使用します。
======= サンプルフォーム UserForm4 =======

Option Explicit

'タイマーコントロール用クラスオブジェクト
Private WithEvents Timer4 As clsTimer

Private DigitalClock(1 To 6) As clsDec7Seg


'7セグメントの表示更新
Private Sub DegitalClock_Change()
Dim strTime As String
Dim j As Integer
    strTime = Format(Now, "hhmmss")
    For j = 1 To 6
        DigitalClock(j).Value = Val(Mid(strTime, j, 1))
    Next j
End Sub


Private Sub UserForm_Initialize()
    Set Timer4 = New clsTimer   'タイマーのインスタンスの生成
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Timer4.DestroyAll   '引数省略(False)で自Form発行タイマーのみ全て破棄
    Set Timer4 = Nothing
End Sub


Private Sub UserForm_Terminate()
    Erase DigitalClock      'デジタル時計の破棄(グレー表示になる)
End Sub


Private Sub Timer4_Tick(ByVal TimerID As Long)
    Select Case TimerID
      Case 1
        Call DegitalClock_Change
    End Select
End Sub


Private Sub cmdStart_Click()
Dim j As Integer
    For j = 1 To 6
        Set DigitalClock(j) = New clsDec7Seg
        'コントロール名: "lblSeg_XY"    X(1-6, hhmmss) , Y(1-7, Segment)
        'セグメント番号を除いたプリフィックスを渡す
        DigitalClock(j).Rgst Me, "lblSeg_" & j
    Next j
    Call DegitalClock_Change

    '1秒間隔タイマー(デジタル時計)を1番で登録
    Timer4.Create Me, TimerID:=1, Interval:=1
End Sub


Private Sub cmdStop_Click()
    Timer4.DestroyAll   '引数省略(False)で自Form発行タイマーのみ全て破棄
    Erase DigitalClock      'デジタル時計の破棄(グレー表示になる)
End Sub

======= 7セグメントクラス clsDec7Seg =======

Option Explicit

' 7セグメントのコントロール名: xxxxN    xxxx:Prefix , N=1-7
' 7セグメントの配置
'     --(1)--
'    I       I
'   (6)     (2)
'    I       I
'     --(7)--
'    I       I
'   (5)     (3)
'    I       I
'     --(4)--
'

Private lbl7Seg(1 To 7) As MSForms.Label
Private blnRgst As Boolean
Private blnSegState(0 To 9, 1 To 7) As Boolean

Private Const cstON As Long = &H8080FF      '薄赤
Private Const cstOFF As Long = &H808080     'Gray


Private Sub Class_Initialize()
Const cstState As String = "1111110,0110000,1101101,1111001," & _
                           "0110011,1011011,1011111,1110000," & _
                           "1111111,1111011"
Dim vntStateWK As Variant
Dim j As Integer
Dim k As Integer

    vntStateWK = Split(cstState, ",")
    For j = 0 To 9
        For k = 1 To 7
            blnSegState(j, k) = CBool(Mid(vntStateWK(j), k, 1))
        Next k
    Next j
End Sub


Private Sub Class_Terminate()
    If (blnRgst = TrueThen
        Me.Value = -1   '全セグメント消灯
    End If
    Erase lbl7Seg
End Sub


'7セグメント用ラベルコントロールは、
'名前の末尾1桁(1 - 7)を除いたプリフィックス名で指定する。
Public Sub Rgst(ByRef argOwner As MSForms.UserForm, ByVal argPrefix As String)
Dim j As Integer
Dim strWK As String

    For j = 1 To 7
        On Error Resume Next
        strWK = ""
        strWK = argOwner.Controls(argPrefix & j).Name
        On Error GoTo 0
        If (strWK = "") Then
            Erase lbl7Seg
            blnRgst = False
            Exit Sub
        End If
        Set lbl7Seg(j) = argOwner.Controls(argPrefix & j)
    Next j
    blnRgst = True
    Me.Value = -1   '全セグメント消灯
End Sub


Public Property Let Value(ByVal argValue As Integer)
Dim j As Integer

    If (blnRgst = FalseThen
        Exit Property
    End If

    If (argValue < 0) Or (argValue > 9) Then
        '[0-9]以外を渡された場合は全セグメント消灯
        For j = 1 To 7
            lbl7Seg(j).BackColor = cstOFF
        Next j
        Exit Property
    End If

    For j = 1 To 7
        If (blnSegState(argValue, j) = TrueThen
            If (lbl7Seg(j).BackColor = cstON) Then
                'そのまま
            Else
                lbl7Seg(j).BackColor = cstON
            End If
        Else
            If (lbl7Seg(j).BackColor = cstOFF) Then
                'そのまま
            Else
                lbl7Seg(j).BackColor = cstOFF
            End If
        End If
    Next j
End Property



 Home   Back Page   Next Page

ロゴ(ゴールド)   ロゴ(ゴールド)

角田 桂一 Mail:addinbox@h4.dion.ne.jp CopyRight(C) 2005 Allrights Reserved.