--- Soumis par Michael Bedward---

Afficher une boîte de dialogue pour un laps de temps déterminé.

     La boîte de dialogue  MsgBox ne permet pas de se fermer automatiquement après un certain temps. On peut cependant fermer cette boîte de dialogue en utilisant un Timer, par exemple.

    Une autre alternative et de construire un formulaire en mode d'exécution, utilisant CreateForm et CreateControl.  Cette fonction utilise ces méthodes pour créer ce formulaire et le fermer automatiquement après un certain temps.

'************* Code Start **************
' Affiche un simple popup dialogue pour un temps 
' prédéterminé en secondes.
'
' Ce code fut écrit par Michael Bedward
' mbedward@ozemail.com.au
' March 31, 1999.
'
' Vous êtes libres de distribuer ce code comme vous le
' désirez, mais il serait agréable de créditer l'auteur initial
' en laissant cette note.  Toute suggestion d'amélioration est
' bienvenue.
'
' Modifications:
'   April 12, 1999
'   Modifications selon suggestion de Mark West (mrwest@engin.umich.edu):
'   pour dimensionner le formulaire selon la longueur du texte;
'   arguments optionels pour la police de caractères ( font name and size);
'   code pour effacer l'object formulaire.
'
'   April 16,1999
'   Ajout de traitement d'erreur selon suggestion de 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
    
    ' utilisé par traitement d'erreur
    '
    savedForm = False
    
    ' empêche le rafraîchissement de l'écran momentannéement
    ' pour éviter de voir le déroulement de la création du formulaire
    '
    On Error GoTo ErrorHandler
    Application.Echo False
    
    ' formulaire tout vide
    '
    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
    
    ' le titre
    '
    If IsMissing(title) Then
        f.Caption = "Info"
    Else
        f.Caption = title
    End If
    
    ' étiquette pour le 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
    lbl.SizeToFit
    dblWidth = lbl.Width + 200
    f.Width = dblWidth - 200
    f.Section(acDetail).Height = lbl.Height + 200
    
    ' affichage du formulaire (tout d'abord, le sauvegarder et le fermer
    ' de sorte qu'il se centre à l'ouverture)
    '
    DoCmd.Close acForm, myName, acSaveYes
    savedForm = True
    DoCmd.OpenForm myName
    DoCmd.MoveSize , , dblWidth
    DoCmd.RepaintObject acForm, myName

    ' rétablir les rafraîchissments d'écran
    '
    Application.Echo True

    ' afficher le formulaire pour un temps limité
    '
    If duration <= 0 Then duration = 2
    Dim startTime As Single
    startTime = Timer
    While Timer < startTime + duration
    Wend
    
    ' fermer et effacer ce formulaire
    '
    DoCmd.Close acForm, myName, acSaveNo
    DoCmd.DeleteObject acForm, myName
    Exit Sub
    
ErrorHandler:
    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 **************