囁くメッセージ-その２

囁くメッセージでは、ちょっと表示してすぐに消える WhisperMessage() を紹介しましたが、似たようなメッセージ表示方法として SnapMessage() をつくってみました。
WhisperMessage() は、メッセージを表示して２秒後に自動的に消えるものでしたが、場合によると、慣れるまで消えてほしくない、慣れれば消えてほしいというようなこともあります。
次の SnapMessageForm を使うと、所定のメッセージを表示して通常は "OK" ボタンを押すまでそのまま保持されます。しかし、チェックボックスにチェックを入れると、その後は　WhisperMessage() のように、表示した後 1.6 秒後に消えるようになります。そうなったフォームには、すでに "OK" ボタンもチェックボックスもなくなっています。
それほど重要な内容ではないが、けじめとしてメッセージは表示したい、だからちょっと表示して消したい、しかし最初のうちはよく見えるように意識的に消すまで表示を保持したい、といった場合に使えます。

使ったユーザーフォームは、左のごとし。配置したコントロールは MessageLabel、OKButtonImage、AutoUnloadCheckBox の３つです。MessageLabel の WordWrap は True にしておきます。
また別に、どこかのワークシート上に "AutoUnloadSw" という名前のセルを用意しておきます。

'--- スイッチを保持するセルの名前
Private Const autoUnloadSwCellName = "AutoUnloadSw"
'--- 自動的に消す場合の表示時間（mSec)
Private Const waitTime = 1600

'--- チェックボックスによってスイッチを ON/OFF
Private Sub AutoUnloadCheckBox_Click()
    autoUnloadSw = AutoUnloadCheckBox.value
End Sub
'--- 表示後、スイッチON であれば一定時間後に消す
Private Sub UserForm_Activate()
    AutoUnloadCheckBox.value = autoUnloadSw
    If autoUnloadSw Then
        Application.Wait [Now()] + waitTime / 86400000
        Unload Me
    End If
End Sub
'--- OK ボタンの MouseUp
Private Sub OKButtonImage_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Unload Me
End Sub
'--- スイッチの状態によってフォームの大きさを変える
Private Sub UserForm_Initialize()
      Me.height = 135
      If autoUnloadSw Then Me.height = 84
End Sub
'--- スイッチの取得・設定
Private Property Get autoUnloadSw()
      autoUnloadSw = Range(autoUnloadSwCellName).value
End Property
Public Property Let autoUnloadSw(sw)
      Range(autoUnloadSwCellName).value = sw
End Property

こうやって使います。
一度チェックボックスにチェックを入れると、もう２度と表示保持型にはなりません。しかし、チェックボックスの値はワークシート上の AutoUnloadSw という名前のセルに保管されていますので、その値を False にすれば、元に戻ります。

Public Sub SnapMessageDemo()
    SnapMessage "報告", "これで仕事が終わりました"
End Sub
Public Sub SnapMessage(title As String, msg As String)
    With SnapMessageForm
        .Caption = title
        .MessageLabel.Caption = msg
        .Show vbModal
    End With
End Sub