Home  |   French  |   About  |   Search  | mvps.org  

What's New
Table Of Contents
10 Commandments 

In Memoriam

Terms of Use

VB Petition

Forms: Display a dialog box for a specified duration

Michael Bedward

     The built-in MsgBox function doesn't allow you to automatically close it after a specified duration.  A workaround is to create a form and close it through it's Timer event.

    Another alternative is to build the form on the fly by using the CreateForm and CreateControl methods.  This function uses these methods to create a form and automatically close it after a specified interval.

'************* Code Start **************
' This code was originally written by Michael Bedward.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
' Code Courtesy of
' Michael Bedward
' Display a simple popup message dialog for a given number of
' seconds.
' This code was written by Michael Bedward
' mbedward@ozemail.com.au
' March 31, 1999.
' You are free to distribute and use this code as you wish
' but it would be nice if you credit the original author
' (by leaving this notice intact).  Improvements will be
' gratefully accepted.
' Modifications:
'   April 12, 1999
'   Added modifications suggested by Mark West (mrwest@engin.umich.edu):
'   code to auto-size form according to label size;
'   optional args to set font name and size;
'   code to delete form object.
'   April 16,1999
'   Added error handler as suggested by Dev Ashish (dash10@hotmail.com).
Sub mxbPopupMessage(ByVal message As String, _
                    Optional ByVal title As Variant, _
                    Optional ByVal duration As Single, _
                    Optional strFontName As String, _
                    Optional intFontSize As Integer)
    Dim f As Form
    Dim lbl As Label
    Dim dblWidth As Double
    Dim myName As String
    Dim savedForm As Boolean
    ' used for error handling
    savedForm = False
    ' turn off screen repainting so that we don't see the
    ' form being created
    On Error GoTo ErrorHandler
    Application.Echo False
    ' make a simple blank form
    Set f = CreateForm
    myName = f.Name
    f.RecordSelectors = False
    f.NavigationButtons = False
    f.DividingLines = False
    f.ScrollBars = 0  ' none
    f.PopUp = True
    f.BorderStyle = acDialog
    f.Modal = True
    f.ControlBox = False
    f.AutoResize = True
    f.AutoCenter = True
    ' set the title
    If IsMissing(title) Then
        f.Caption = "Info"
        f.Caption = title
    End If
    ' add a label for the message
    Set lbl = CreateControl(f.Name, acLabel)
    lbl.Caption = message
    lbl.BackColor = 0 ' transparent
    lbl.ForeColor = 0
    lbl.Left = 100
    lbl.Top = 100
    If strFontName <> "" Then lbl.FontName = strFontName
    If intFontSize > 0 Then lbl.FontSize = intFontSize
    dblWidth = lbl.Width + 200
    f.Width = dblWidth - 200
    f.Section(acDetail).Height = lbl.Height + 200
    ' display the form (first close and save it so that when
    ' it is reopened it will auto-centre itself)
    DoCmd.Close acForm, myName, acSaveYes
    savedForm = True
    DoCmd.OpenForm myName
    DoCmd.MoveSize , , dblWidth
    DoCmd.RepaintObject acForm, myName

    ' turn screen repainting back on again
    Application.Echo True

    ' display form for specifed number of seconds
    If duration <= 0 Then duration = 2
    Dim startTime As Single
    startTime = Timer
    While Timer < startTime + duration
    ' close and delete the form
    DoCmd.Close acForm, myName, acSaveNo
    DoCmd.DeleteObject acForm, myName
    Exit Sub
    Application.Echo True
    Dim i As Integer
    For Each f In Forms
      If f.Name = myName Then
        DoCmd.Close acForm, myName, acSaveNo
        Exit For
      End If
    Next f
    If savedForm Then
      DoCmd.DeleteObject acForm, myName
    End If
End Sub
'************* Code End **************

1998-2010, Dev Ashish & Arvin Meyer, All rights reserved. Optimized for Microsoft Internet Explorer