「BakuJAN活用例」の解･体･親･書

親愛なる貴方のために・・・え？誰？

５.点滅するボタンコントロール

　定まった操作手順があったり、似たようなコントロールが複数存在している場合は、目的のコントロールにフォーカスを移動させてアクティブにしたり、メッセージボックスや音を鳴らしたりすることで、その存在をユーザーに知らせることができます。

　強烈にその存在を知らしめる手段として、コントロールを「点滅」させてみましょう。マクロが中断しないよう[ DoEvents関数 ]を使って、ルーチンをOS（オペレーティング システム）へ渡します。

• 　★　 コントロールの色を変更して、点滅しているように見せる
  Option Explicit Private Declare Function GetTickCount Lib "kernel32" () As Long Private Sub Blink() If MultiPage1.Value = 0 Then Exit Sub ElseIf MultiPage1.Value = 1 Then Btn_End01.SetFocus: Set S_Item = Btn_End01 ElseIf MultiPage1.Value = 2 Then Btn_End02.SetFocus: Set S_Item = Btn_End02 ElseIf MultiPage1.Value = 3 Then Btn_End03.SetFocus: Set S_Item = Btn_End03 ElseIf MultiPage1.Value = 4 Then Btn_End04.SetFocus: Set S_Item = Btn_End04 ElseIf MultiPage1.Value = 5 Then If Btn_End05.Visible = False Then _ MsgBox "バスワード以外で終了できません。", vbCritical,_ "ユーザー認証": Exit Sub Btn_End05.SetFocus: Set S_Item = Btn_End05 ElseIf MultiPage1.Value = 6 Then Btn_End06.SetFocus: Set S_Item = Btn_End06 End If V_col = 0: V_row = 0 Do: Do DoEvents Loop Until GetTickCount - V_row > 100 If S_Item.BackColor = RGB(255, 255, 0) Or _ S_Item.BackColor = -2147483633 Then S_Item.ForeColor = RGB(255, 255, 0): S_Item.BackColor = 0: V_col = V_col + 1 ElseIf S_Item.BackColor = 0 Then S_Item.BackColor = RGB(255, 255, 0): S_Item.ForeColor = 0: V_col = V_col + 1 End If V_row = GetTickCount DoEvents Loop Until V_col >= 10 S_Item.ForeColor = 0: S_Item.BackColor = -2147483633 End Sub
• 　[ MultiPageコントロール ]には６枚の[ Pageオブジェクト ]があり、それぞれに終了ボタンの[ Btn_End* ]が配置されています。現在アクティブになっているマルチページコントロールの[ MultiPage1.Valueプロパティ ]で位置を判断し、共通の点滅ルーチンを使っています。
  　
  点滅させるコマンドボタンコントロールを選択するために、[ If〜Then〜Elseステートメント ]を使いましたが、[ Select Caseステートメント ]を使ったほうが、良い場合があります。次のプロシージャは、先のコードと同じ動作を行います。
  　
• 　★　 コントロールの色を変更して、点滅しているように見せる
  Option Explicit Private Declare Function GetTickCount Lib "kernel32" () As Long Private Sub Blink() Select Case MultiPage1.Value Case 0: Exit Sub Case 1: Btn_End01.SetFocus: Set S_Item = Btn_End01 Case 2: Btn_End02.SetFocus: Set S_Item = Btn_End02 Case 3: Btn_End03.SetFocus: Set S_Item = Btn_End03 Case 4: Btn_End04.SetFocus: Set S_Item = Btn_End04 Case 5: If Btn_End05.Visible = False Then _ MsgBox "バスワード以外で終了できません。", vbCritical, _ "ユーザー認証": Exit Sub Btn_End05.SetFocus: Set S_Item = Btn_End05 Case 6: Btn_End06.SetFocus: Set S_Item = Btn_End06 Case Else End Select V_col = 0: V_row = 0 Do: Do DoEvents Loop Until GetTickCount - V_row > 100 If S_Item.BackColor = RGB(255, 255, 0) Or _ S_Item.BackColor = -2147483633 Then S_Item.ForeColor = RGB(255, 255, 0): S_Item.BackColor = 0: V_col = V_col + 1 ElseIf S_Item.BackColor = 0 Then S_Item.BackColor = RGB(255, 255, 0): S_Item.ForeColor = 0: V_col = V_col + 1 End If V_row = GetTickCount DoEvents Loop Until V_col >= 10 S_Item.ForeColor = 0: S_Item.BackColor = -2147483633 End Sub
• 同じ動作を行うコードでも、簡単に済ませたほうが実行速度も速くなります。

番外５.

　API関数[ GetTickCount ]を使って、経過時間によって情報の時間をカウントダウンすることもできます。メインルーチンの進行状況に拠らない処理を行うことができます。

• 　★　 複数のプロシージャをバックグラウンドで動作させる
  Private Sub Edt_LogADD_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Btn_End05.Visible = True Then Cancel = False If Flg_pw = True Then Cancel = True If Edt_LogADD.Value <> Empty Then _ Edt_CmsA.Value = UCase(Edt_LogADD.Value): Edt_LogADD.Value = Empty If Edt_CmsA.Value = UCase(Right(Twb.Comments, 8)) Then _ Flg_pw = False: Frm_01.Visible = True: Btn_Sept01.Visible = True: _ Btn_Sept02.Visible = True: login: Cancel = False: _ Edt_dmy06.Value = Empty: _ EdtTime00.Value = Empty: Cmb_CmsB_Add: Cmb_CmsB.Value = Empty: _ Lst_CmsCnt.Clear: _ Frm_01.Enabled = True: Btn_End05.Visible = True: Btn_End05.SetFocus: _ Exit Sub For i = 2 To WorksheetFunction.CountA(ThisWorkbook.Sheets("CMS_名簿") _ .Range("A:A")) Pwd_ad = ThisWorkbook.Sheets("CMS_名簿").Range("a" & i) If UCase(Edt_CmsA) = UCase(Pwd_ad) Then If Btn_End05.Visible = False Then login With CreateObject("Scripting.FileSystemObject").OpenTextFile( _ ThisWorkbook.Path & "\cmslogin.log", 8, True, -2) .WriteLine """" & Edt_CYY.Value & "/" _ & Right("0" & Edt_CMM.Value, 2) & _ & "/" Right("0" & Day(Now), 2) & " " _ & Right("0" & Hour(Now), 2) & _ & ":" Right("0" & Minute(Now), 2) & ":" _ & Right("0" & Second(Now), 2) _ & """,""" & "IN:" & UCase(Edt_CmsA) & """,""" & "0""" .Close End With Cmb_CmsB.Value = ThisWorkbook.Sheets("CMS_名簿").Cells(i, 2) Cancel = True: Frm_01.Visible = True: Flg_pw = True: Exit For End If Next If Btn_End05.Visible = True Then _ Cancel = False: Frm_01.Enabled = True: Edt_LogADD.SetFocus: Exit Sub If Btn_End05.Visible = False Then Cancel = True: Frm_01.Enabled = False Edt_dmy06.Value = 15 Do While Flg_pw = True Edt_dmy06.Value = Edt_dmy06.Value ? 1: IN_cnt = GetTickCount If Edt_dmy06.Value <= 0 Then Flg_pw = False: Exit Do Do While Flg_pw = True DoEvents: EdtTime00.Value = Now If GetTickCount - IN_cnt >= 1000 Then Exit Do Loop Loop Lst_CmsCnt.Clear: Cmb_CmsB.Text = Empty: Edt_CmsA.Value = Empty: _ Edt_CmsC.Value = Empty Edt_CmsS.Value = Empty: Edt_CmsT.Value = Empty: Edt_dmy06.Value = Empty If Frm_01.Visible = True And Btn_End05.Visible = False Then _ Edt_LogADD.SetFocus: Frm_01.Visible = False If Btn_End05.Visible = False Then Cancel = True Edt_LogADD.SetFocus End Sub
• 　このマクロは、ログイン用のパスワードを格納するテキストボックス[ Edt_LogADD ]の値が決定されると[ Exitイベント ]を使って動き出します。[ DoEvents関数 ]によって、バックグラウンドでカウント動作をしているため、このプロシージャの終了を待たないで、他のプロシージャを実行することができます。
  　
• 　★　 カウントダウン・カウントアップタイマーを使う
  　[ Flg_pw ]は変数で、「フラグ」の役割を持っています。[ Do While〜Loopステートメント ]は、テキストボックスの[ Edt_dmy06 ]で指定した「15秒（正しくは0まで-1ずつカウントダウン）」の間だけループを繰り返し、テキストボックスの[ EdtTime00 ]の年月日と時分秒をリアルタイムで更新していきます。
  　
  　また、このフラグの値が[ False ]になると、ループから抜けるような判定も行っています。この15秒間は、[ DoEvents関数 ]によって別のルーチンも動かすことができますので、[ Flg_pw ]を[ False ]にするプロシージャによって、15秒の経過を待たずにループを終了させることができます。

　ユーザーフォームは、ステータスバーを持っていませんが、[ UserForm* ]の[ Captionプロパティ ]や[ Labelコントロール ]を使って、現在時刻を更新し続けることもできますね。