#298 オリジナルのポップアップメッセージを表示する例 フォーム、VBA

オリジナルのポップアップメッセージ(というより実際は小さなフォーム)をちょっとの時間だけ表示させる例です。

ここではフォームをあらかじめ作成してデータベースに保存しておくのではなく、このプロシージャにおいて動的に生成、そして表示後に破棄するようにしています。Accessが自動表示してくれる「ヒントテキスト」プロパティの機能とは違い、メッセージ用のフォームを自分で生成するので、背景色やフォント色・フォントサイズ、ウィンドウサイズなど、さまざまなプロパティを自由に設定することができます。

標準モジュールに次のような「ShowPopupMsg」プロシージャを作って、利用例のように呼び出して使ってください。
Public Sub ShowPopupMsg(strMsg As String, Optional ByVal varTimer As Variant)
'概要 オリジナルのポップアップメッセージフォームを表示する
'引数 strMsg   : メッセージ内容
'     varTimer : 表示時間(Sec) 省略時は1Sec
'返値 なし

  Dim frm As Form
  Dim lblMsg As Label
  Dim strFrmName As String
  Dim sngStart As Single
  
  On Error GoTo Err_Handler

  'フォームデザインを表示させないようにします
  Echo False

  '空のフォームを生成(プロパティは任意に設定してください)
  Set frm = CreateForm
  With frm
    strFrmName = .Name
    .RecordSelectors = False
    .NavigationButtons = False
    .BorderStyle = 0
    .AutoCenter = True
    .AutoResize = True
    .ScrollBars = 0
  End With

  'メッセージ用のラベルを生成(プロパティは任意に設定してください)
  Set lblMsg = CreateControl(strFrmName, acLabel)
  With lblMsg
    .Caption = strMsg
    .Left = 50
    .Top = 50
    .SizeToFit
    frm.Width = .Width + 100
    frm.Section(acDetail).Height = .Height + 100
    frm.Section(acDetail).BackColor = 13697023
  End With

  'フォームを一時的に保存して再オープンします
  DoCmd.Close acForm, strFrmName, acSaveYes
  DoCmd.OpenForm strFrmName
  DoCmd.RepaintObject acForm, strFrmName

  Echo True

  '指定時間待機します
  If IsMissing(varTimer) Then varTimer = 1
  sngStart = Timer
  Do
  Loop Until Timer >= sngStart + varTimer

Exit_Here:
  On Error Resume Next
  Echo True
  'フォームを閉じてデータベースより削除します
  DoCmd.Close acForm, strFrmName, acSaveNo
  DoCmd.DeleteObject acForm, strFrmName
  Exit Sub

Err_Handler:
  Resume Exit_Here:
  
End Sub

利用例:
ShowPopupMsg "短いメッセージを表示します!"

ShowPopupMsg "短いメッセージを3秒間表示します!", 3
実行結果の例
| Index | Prev | Next |

この情報は参考になりましたか?、問題は解決しましたか?、もしまだなら......
T'sWareのワンポイトテクニカルアドバイスをご利用ください。3000円/件〜でご支援します。
スタンドアロンからSQL Server対応まで、オーダーメイドのシステムを短納期・安価でお届けします


Copyright © T'sWare All rights reserved