I. Avant-propos▲
Ce document a pour but de vous montrer comment concevoir un formulaire MsgBox qui reprend l'aspect de la boîte de message renvoyée par cette fonction.
En effet, lorsque vous utilisez la fonction MsgBox(), il est impératif (excepté si vous passez par des API Windows) d'utiliser la souris ou le clavier en cliquant sur un bouton (ou en tapant sur la touche correspondante) dans la fenêtre afin de répondre au message. Cela permet d'une part de fermer la boîte de dialogue puis d'exécuter une suite d'opérations qui a été codée après l'appel de cette fonction.
Grâce à ce tutoriel, vous serez en mesure de concevoir des formulaires de substitution paramétrables à souhait.
I-A. Remerciements▲
Je tiens à remercier tout particulièrement toutes celles et tous ceux qui ont participé à la relecture de ce document en y incluant leurs remarques.
I-B. Contact▲
Pour tout renseignement complémentaire, veuillez me contacter directement (Argyronet) par MP.
II. Présentation du projet▲
Je vous précise avant de continuer la lecture de ce tutoriel que les exemples montrés ci-après restent totalement génériques et n'offrent pas de possibilité de transposer ces derniers sur des cas vraiment concrets.
En fin de tutoriel, j'aborderai un chapitre qui présentera deux exemples classiques et aussi la possibilité d'utiliser l'ouverture de ce type de formulaire comme lorsque l'on appelle la fonction MsgBox().
II-A. Comment se présente le projet ?▲
Pour réaliser ce tutoriel, j'ai conçu un générateur d'appel générique d'un même formulaire que j'ai nommé frmMsgBox() pour la circonstance.
Ce générateur va vous parler tout de suite puisque vous allez, rien qu'en regardant l'illustration, déterminer quel est son rôle.
Bien entendu, ce formulaire générateur n'est que le reflet théorique du tutoriel puisque dans la pratique, vous ne devez pas l'utiliser, mais simplement vous inspirer de la syntaxe d'appel d'ouverture pour que les formulaires MsgBox() que vous allez créer soient affichés.
Comme vous pouvez le voir, tous les contrôles employés sur ce formulaire sont le reflet des cas les plus typiques de l'usage de la fonction MsgBox().
Rappel sur la fonction MsgBox
Cette fonction affiche un message dans une boîte de dialogue et attend que l'utilisateur clique sur un des boutons. Elle renvoie alors une valeur de type Integer qui stipule le bouton qu'a choisi l'utilisateur. La syntaxe de la fonction MsgBox() est la suivante :
MsgBox
(
prompt[, buttons] [, title] [, helpfile, context])
Pour davantage de précisions sur la fonction MsgBox(), je vous invite à consulter votre fichier d'aide en utilisant comme mot clé le nom de cette fonction ou bien en cliquant ici.
II-B. Comment fonctionne ce formulaire ?▲
Le fonctionnement de ce formulaire est relativement simple. Chaque contrôle est exploité de manière à ce qu'il renvoie une valeur correspondant à chacune des valeurs nécessaires aux paramètres de la fonction MsgBox().
En effet, afin de faciliter la manipulation des futurs formulaires, je me suis inspiré de la syntaxe et des paramètres de cette fonction MsgBox().
De ce fait, j'ai utilisé en les copiant dans mon code, ses constantes et les ai affectées plus particulièrement aux contrôles Cadre d'option.
Les étiquettes de description suivies d'un astérisque (*) précisent que ces paramètres ne font pas partie de la fonction MsgBox().
Ainsi que vous pouvez le constater, les éléments du formulaire reprennent les paramètres nommés de la fonction MsgBox().
Il sera alors aisé de les affecter au formulaire frmMsgBox() exemple que vous allez concevoir.
II-C. Code du formulaire générateur▲
Je vous rappelle que ce formulaire ne doit pas être inclus dans votre application.
Seul le code qu'il contient doit être exploité à bon escient.
Option
Compare Database
Option
Explicit
Const
MESSAGE_0 As
String
=
"Ceci est un message "
Const
MESSAGE_1 As
String
=
" pour afficher un formulaire MsgBox"
Const
MESSAGE_2 As
String
=
"Ceci montre qu'il est possible de faire des formulaires un peu originaux..."
Const
MESSAGE_3 As
String
=
"Voulez-vous poursuivre ?"
Const
MESSAGE_4 As
String
=
"Cliquez sur OK pour continuer ?"
Const
MSGBOX_TITLE As
String
=
"Afficher un formulaire Msgbox"
Private
Sub
chkAutoClose_Click
(
)
'*********************************************************
' Procédure permettant d'activer les contrôles Durée et Message
' et d'affecter 10 secondes par défaut à la durée
'*********************************************************
Me.txtDelay.Enabled
=
Me!chkAutoClose
Me!txtDelay =
IIf
(
Me!chkAutoClose, 10
, 0
)
Me.txtAutoClose.Enabled
=
Me!chkAutoClose
End
Sub
Private
Sub
cmdClose_Click
(
)
'*********************************************************
' Procédure permettant de fermer ce formulaire
'*********************************************************
DoCmd.Close
acForm, Me.Name
End
Sub
Private
Sub
cmdShow_Click
(
)
'*********************************************************
' Procédure permettant d'ouvrir le formulaire frmMsgbox
'*********************************************************
Dim
strIcons As
String
Dim
strButtons As
String
Dim
strDefault As
String
Dim
strMessage As
String
Dim
strTitle As
String
Dim
strCloseAuto As
String
Dim
strCloseDelay As
String
Dim
strArgs As
String
Dim
strMessageAutoClose As
String
strMessage =
Me!txtMessage
strIcons =
Me!fraIcons
strButtons =
Me!fraButtons
strDefault =
Me!fraDefault
strTitle =
Me!txtTitle
strCloseAuto =
Me!chkAutoClose
strCloseDelay =
Me!txtDelay
strMessageAutoClose =
IIf
(
IsNull
(
Me!txtAutoClose), ""
, Me!txtAutoClose)
strArgs =
strMessage &
SEPARATOR &
strIcons &
SEPARATOR &
strButtons &
SEPARATOR &
strDefault &
_
SEPARATOR &
strTitle &
SEPARATOR &
strCloseAuto &
SEPARATOR &
strCloseDelay &
SEPARATOR &
_
strMessageAutoClose
DoCmd.OpenForm
"frmMsgbox"
, acNormal, , , , acDialog, strArgs
End
Sub
Private
Sub
Form_Load
(
)
'*********************************************************
' Procédure permettant d'initialiser les contrôles
'*********************************************************
Dim
strMessage As
String
Dim
strTitle As
String
Me!chkAutoClose =
False
strMessage =
"Alerte !"
&
vbCrLf
&
MESSAGE_0 &
"d'alerte"
&
MESSAGE_1 &
vbCrLf
&
MESSAGE_2
strTitle =
MSGBOX_TITLE
Me!txtMessage =
strMessage
Me!txtTitle =
strTitle
Me!txtDelay =
0
End
Sub
Private
Sub
fraButtons_AfterUpdate
(
)
'*********************************************************
' Procédure permettant de forcer le bouton à OK si Default = Bouton 1
' Les textes se rafraîchissent en conséquence
'*********************************************************
Me!fraDefault =
IIf
(
Me!fraButtons =
0
, 0
, Me!fraDefault)
RefreshMessage
End
Sub
Private
Sub
fraDefault_BeforeUpdate
(
Cancel As
Integer
)
'*********************************************************
' Procédure permettant de vérifier la concordance des contrôles
'*********************************************************
If
Me!fraButtons =
0
And
Me!fraDefault >
0
Then
Msgbox
"Si le bouton OK est choisi, le bouton par défaut doit-être 1 !"
, 48
, "Choix incorrect"
Cancel =
True
End
If
End
Sub
Private
Sub
fraIcons_AfterUpdate
(
)
'*********************************************************
' Les textes se rafraîchissent en conséquence de la valeur choisie
'*********************************************************
RefreshMessage
End
Sub
Private
Sub
txtAutoClose_Exit
(
Cancel As
Integer
)
'*********************************************************
' Procédure permettant de vérifier qu'un message d'autofermeture est stipulé
'*********************************************************
If
Len
(
Me!txtAutoClose.Text
) =
0
Then
If
_
Msgbox
(
"Si vous ne spécifiez pas de message, un message par défaut sera affecté..."
, _
49
, "Message de fermeture"
) =
vbOK
Then
Me!txtAutoClose =
DEFAULT_MSG_AUTOCLOSE
Else
Cancel =
True
End
If
End
If
End
Sub
Private
Sub
txtDelay_BeforeUpdate
(
Cancel As
Integer
)
'*********************************************************
' Procédure permettant de contrôler le temps de fermeture automatique
'*********************************************************
Dim
intDelay As
Integer
intDelay =
Me!txtDelay.Text
If
intDelay >
120
Then
If
Msgbox
(
"Confirmez-vous ce temps de "
&
Trim
(
Str
(
intDelay)) &
_
" secondes ?"
, 36
, "Délai"
) =
vbYes
Then
Else
Cancel =
True
End
If
End
If
End
Sub
Private
Sub
txtDelay_Exit
(
Cancel As
Integer
)
'*********************************************************
' Procédure permettant de contrôler qu'une valeur a été entrée
'*********************************************************
If
Len
(
Me!txtDelay.Text
) =
0
Then
If
Msgbox
(
"Un délai en secondes est requis..."
&
vbCrLf
&
_
"Voulez-vous affecter un délai par défaut ? (10 secondes)"
, 49
, _
"Délai de fermeture"
) =
vbOK
Then
Me!txtDelay =
10
Else
Cancel =
True
End
If
End
If
End
Sub
Private
Sub
txtDelay_KeyPress
(
KeyAscii As
Integer
)
'*********************************************************
' Procédure permettant de forcer la saisie numérique
'*********************************************************
Select
Case
KeyAscii
Case
48
To
57
Case
Else
KeyAscii =
0
End
Select
End
Sub
Private
Sub
RefreshMessage
(
)
'*********************************************************
' Procédure permettant de rafraîchir les messages selon les choix établis
'*********************************************************
Dim
strMessage As
String
Select
Case
Me!fraIcons
Case
MB_ICONSTOP
Select
Case
Me!fraButtons
Case
MB_OK
strMessage =
"Stop !"
&
vbCrLf
&
MESSAGE_0 &
"critique"
&
MESSAGE_1 &
_
vbCrLf
&
MESSAGE_2
Case
MB_OKCANCEL
strMessage =
"Stop !"
&
vbCrLf
&
MESSAGE_0 &
"critique"
&
MESSAGE_1 &
_
vbCrLf
&
MESSAGE_2 &
vbCrLf
&
vbCrLf
&
MESSAGE_4
Case
MB_YESNO
strMessage =
"Stop !"
&
vbCrLf
&
MESSAGE_0 &
"critique"
&
MESSAGE_1 &
_
vbCrLf
&
MESSAGE_2 &
vbCrLf
&
vbCrLf
&
MESSAGE_3
Case
MB_YESNOCANCEL
strMessage =
"Stop !"
&
vbCrLf
&
MESSAGE_0 &
"critique"
&
MESSAGE_1 &
_
vbCrLf
&
MESSAGE_2 &
vbCrLf
&
vbCrLf
&
MESSAGE_3
End
Select
Case
MB_ICONQUESTION
Select
Case
Me!fraButtons
Case
MB_OK
strMessage =
"Question !"
&
vbCrLf
&
MESSAGE_0 &
"avec question"
&
_
MESSAGE_1 &
vbCrLf
&
MESSAGE_2
Case
MB_OKCANCEL
strMessage =
"Question !"
&
vbCrLf
&
MESSAGE_0 &
"avec question"
&
_
MESSAGE_1 &
vbCrLf
&
MESSAGE_2 &
vbCrLf
&
vbCrLf
&
MESSAGE_4
Case
MB_YESNO
strMessage =
"Question !"
&
vbCrLf
&
MESSAGE_0 &
"avec question"
&
_
MESSAGE_1 &
vbCrLf
&
MESSAGE_2 &
vbCrLf
&
vbCrLf
&
MESSAGE_3
Case
MB_YESNOCANCEL
strMessage =
"Question !"
&
vbCrLf
&
MESSAGE_0 &
"avec question"
&
_
MESSAGE_1 &
vbCrLf
&
MESSAGE_2 &
vbCrLf
&
vbCrLf
&
MESSAGE_3
End
Select
Case
MB_ICONEXCLAMATION
Select
Case
Me!fraButtons
Case
MB_OK
strMessage =
"Alerte !"
&
vbCrLf
&
MESSAGE_0 &
"d'alerte"
&
MESSAGE_1 _
&
vbCrLf
&
MESSAGE_2
Case
MB_OKCANCEL
strMessage =
"Alerte !"
&
vbCrLf
&
MESSAGE_0 &
"d'alerte"
&
MESSAGE_1 _
&
vbCrLf
&
MESSAGE_2 &
vbCrLf
&
vbCrLf
&
MESSAGE_4
Case
MB_YESNO
strMessage =
"Alerte !"
&
vbCrLf
&
MESSAGE_0 &
"d'alerte"
&
MESSAGE_1 _
&
vbCrLf
&
MESSAGE_2 &
vbCrLf
&
vbCrLf
&
MESSAGE_3
Case
MB_YESNOCANCEL
strMessage =
"Alerte !"
&
vbCrLf
&
MESSAGE_0 &
"d'alerte"
&
MESSAGE_1 _
&
vbCrLf
&
MESSAGE_2 &
vbCrLf
&
vbCrLf
&
MESSAGE_3
End
Select
Case
MB_ICONINFORMATION
Select
Case
Me!fraButtons
Case
MB_OK
strMessage =
"Information !"
&
vbCrLf
&
MESSAGE_0 &
"d'information"
&
_
MESSAGE_1 &
vbCrLf
&
MESSAGE_2
Case
MB_OKCANCEL
strMessage =
"Information !"
&
vbCrLf
&
MESSAGE_0 &
"d'information"
&
_
MESSAGE_1 &
vbCrLf
&
MESSAGE_2 &
vbCrLf
&
vbCrLf
&
MESSAGE_4
Case
MB_YESNO
strMessage =
"Information !"
&
vbCrLf
&
MESSAGE_0 &
"d'information"
&
_
MESSAGE_1 &
vbCrLf
&
MESSAGE_2 &
vbCrLf
&
vbCrLf
&
MESSAGE_3
Case
MB_YESNOCANCEL
strMessage =
"Information !"
&
vbCrLf
&
MESSAGE_0 &
"d'information"
&
_
MESSAGE_1 &
vbCrLf
&
MESSAGE_2 &
vbCrLf
&
vbCrLf
&
MESSAGE_3
End
Select
End
Select
Me!txtMessage =
strMessage
End
Sub
III. Conception du formulaire MsgBox()▲
Pour concevoir le formulaire MsgBox(), il vous suffit de créer un nouveau formulaire en mode création.
Depuis la fenêtre Base de données, choisissez Nouveau.
L'image ci-après apparaît et vous sélectionnez alors Mode création
Vous n'avez pas de table ni de requête à affecter comme source du formulaire pour cet exemple.
Cliquez sur OK
III-A. Étape 1 : Création du formulaire▲
Le formulaire se présente vide avec seulement la section Détail visible.
Faites alors en sorte que les dimensions du formulaire soient respectivement et approximativement pour la hauteur et la largeur de 3,7 cm et 13,5 cm.
C'est la taille moyenne pour les fenêtres affichées lors de l'appel de la fonction MsgBox().
III-B. Étape 2 : Mise en place des contrôles▲
Vous devez poser sur ce formulaire les contrôles nécessaires comme suit :
Cinq contrôles Image
- Vous poserez d'abord un contrôle Image de 0,847 cm de côté à 0,238 cm du bord gauche et 0,291 cm du bord haut.
- Vous nommerez ce contrôle :
- imgIcon
- Vous poserez ensuite quatre contrôles Image de 0,847 cm de côté que vous pouvez ranger où bon vous semble sur le formulaire, ces derniers étant invisibles (Visible=False).
- Vous nommerez ces contrôles :
- imgExclamation
- imgQuestion
- imgStop
- imgInformation
Deux contrôles Label
- Vous poserez ensuite un premier contrôle Label de 11,852 cm de large et 1,799 cm de haut que vous déposerez à 1,693 cm du bord gauche et 0,291 cm du bord haut.
- Vous nommerez ce contrôle :
- lblMessage
- Vous poserez également un second contrôle Label de 13,413 cm de large et 0,423 cm de haut que vous déposerez à 0,053 cm du bord gauche et 2,963 cm du bord haut.
- Vous nommerez ce contrôle :
- lblCloseMessage
Trois contrôles Button
- Vous poserez enfin trois contrôles Button de 2,593 cm de large et 0,635 cm de haut que vous déposerez respectivement à 2,751 cm, 5,503 cm, 8,254 cm du bord gauche et 2,222 cm du bord haut.
- Vous nommerez respectivement de gauche à droite ces contrôles :
- cmdButton1
- cmdButton2
- cmdButton3
III-C. Le formulaire Msgbox() en mode création▲
Une fois le formulaire terminé, vous devez obtenir quelque chose comme ceci :
Vous remarquerez que j'ai posé des # sur les contrôles.
Cette petite maniaquerie m'indique du premier coup d'œil que la propriété Caption est dynamique et affectée par code.
Pour obtenir les icônes représentant les images qui sont affectées aux contrôles Image, vous pouvez, si vous avez Visual Basic 6.0, les copier depuis le répertoire C:\Program Files\Microsoft Visual Studio\Common\Graphics\Icons\Computer
(si bien entendu, vous l'avez installé sur le disque C sans modifier le chemin d'installation) ou bien les télécharger ici.
III-C-1. Définition des propriétés du formulaire▲
Pour s'assurer que le formulaire s'affiche comme un MsgBox(), il faut lui attribuer les propriétés suivantes :
Vous affecterez comme l'illustre l'image ci-dessus, les propriétés telles que définies en rose.
IV. Code du formulaire MsgBox()▲
Pour être opérationnel, le formulaire MsgBox() possède quelques dizaines de lignes de code…
Le code principal est posé dans l'événement Form_Load().
IV-A. Ensemble du code du formulaire MsgBox()▲
Option
Compare Database
Option
Explicit
Private
Const
MB_TEXT_OK =
"&OK"
Private
Const
MB_TEXT_CANCEL =
"&Annuler"
Private
Const
MB_TEXT_RETRY =
"&Recommencer"
Private
Const
MB_TEXT_YES =
"&Oui"
Private
Const
MB_TEXT_NO =
"&Non"
Private
m_lngTimeOut As
Long
Private
m_strMessageAutoClose As
String
Private
m_lngDefaultButton As
Long
Private
m_lngButtons As
Long
Private
Sub
cmdButton1_Click
(
)
'*********************************************************
' Procédure Click du bouton 1
' Vous remplacez donc les MsgBox() par votre propre procédure
'*********************************************************
Select
Case
cmdButton1.Caption
Case
MB_TEXT_OK
Msgbox
"1er bouton (OK)"
Case
MB_TEXT_YES
Msgbox
"1er bouton (OUI)"
Case
MB_TEXT_RETRY
Msgbox
"1er bouton (RECOMMENCER)"
End
Select
DoCmd.Close
acForm, Me.Name
End
Sub
Private
Sub
cmdButton2_Click
(
)
'*********************************************************
' Procédure Click du bouton 2
' Vous remplacez donc les MsgBox() par votre propre procédure
'*********************************************************
Select
Case
cmdButton2.Caption
Case
MB_TEXT_NO
Msgbox
"2e bouton (NON)"
Case
MB_TEXT_CANCEL
Msgbox
"2e bouton (ANNULER)"
End
Select
DoCmd.Close
acForm, Me.Name
End
Sub
Private
Sub
cmdButton3_Click
(
) 'Always Cancel
'*********************************************************
' Procédure Click du bouton 3
' Vous remplacez donc les MsgBox() par votre propre procédure
'*********************************************************
Msgbox
"3e bouton (ANNULER)"
DoCmd.Close
acForm, Me.Name
End
Sub
Private
Sub
Form_Load
(
)
'*********************************************************
' Procédure Form_Load
'*********************************************************
Const
FORM_HEIGHT_WITH_AUTOCLOSE As
Integer
=
1760
Const
FORM_HEIGHT_WITHOUT_AUTOCLOSE As
Integer
=
2000
Const
LABEL_HEIGHT_WITH_AUTOCLOSE As
Integer
=
225
Const
LABEL_HEIGHT_WITHOUT_AUTOCLOSE As
Integer
=
0
Dim
strMessage As
String
Dim
intIcons As
Integer
Dim
strTitle As
String
Dim
blnCloseAuto As
Boolean
Dim
straArgs
(
) As
String
' ----> Contrôle du contenu de OpenArgs (Tableau de string de 8 éléments)
' ----> Affectation des éléments du tableau aux variables
If
Not
IsNull
(
Me.OpenArgs
) Then
straArgs =
Split
(
Me.OpenArgs
, SEPARATOR)
strMessage =
straArgs
(
0
)
intIcons =
CInt
(
straArgs
(
1
))
m_lngButtons =
CLng
(
straArgs
(
2
))
m_lngDefaultButton =
CLng
(
straArgs
(
3
))
strTitle =
straArgs
(
4
)
blnCloseAuto =
CBool
(
straArgs
(
5
))
m_lngTimeOut =
straArgs
(
6
)
m_strMessageAutoClose =
IIf
(
Len
(
straArgs
(
7
)), straArgs
(
7
), IIf
(
m_lngTimeOut, DEFAULT_MSG_AUTOCLOSE, ""
))
' ----> Redimenssionnement du formulaire si AutoClose n'est pas utilisé
If
m_lngTimeOut Then
Me.lblCloseMessage.Height
=
LABEL_HEIGHT_WITH_AUTOCLOSE
Me.InsideHeight
=
FORM_HEIGHT_WITHOUT_AUTOCLOSE
Else
Me.lblCloseMessage.Height
=
LABEL_HEIGHT_WITHOUT_AUTOCLOSE
Me.InsideHeight
=
FORM_HEIGHT_WITH_AUTOCLOSE
End
If
Else
' ----> OpenArgs est vide (Tentative d'ouverture du formulaire seul)
Msgbox
"Impossible d'afficher le message !"
, 48
, "Erreur interne"
DoCmd.Close
acForm, Me.Name
Exit
Sub
End
If
' ----> Initialisation du Timer à 1 seconde selon le cas
If
blnCloseAuto Then
Me.TimerInterval
=
1000
Else
Me.TimerInterval
=
0
End
If
' ----> Affectation des variables aux contrôles
lblCloseMessage.Caption
=
vbNullString
subShowIcon intIcons
subShowButtons m_lngButtons, m_lngDefaultButton
Caption =
strTitle
Me!lblMessage.Caption
=
strMessage
End
Sub
Private
Sub
subShowIcon
(
ByVal
Icon As
Integer
)
'*********************************************************
' Procédure d'affectation de l'image à l'icône selon la valeur de Icon
'*********************************************************
Select
Case
Icon
Case
MB_ICONEXCLAMATION
imgIcon.Picture
=
Me!imgExclamation.Picture
Case
MB_ICONINFORMATION
imgIcon.Picture
=
Me!imgInformation.Picture
Case
MB_ICONQUESTION
imgIcon.Picture
=
Me!imgQuestion.Picture
Case
MB_ICONSTOP
imgIcon.Picture
=
Me!imgStop.Picture
End
Select
End
Sub
Private
Sub
subShowButtons
(
ByVal
Buttons As
Long
, ByVal
DefaultButton As
Integer
)
'*********************************************************
' Procédure de positionnement des boutons selon la valeur de Buttons et DefaultButton
'*********************************************************
Const
LEFT_POSITION_1ST_1BUTTON =
3295
Const
LEFT_POSITION_1ST_2BUTTONS =
2475
Const
LEFT_POSITION_2ND_2BUTTONS =
4020
Const
LEFT_POSITION_1ST_3BUTTONS =
1560
Const
LEFT_POSITION_2ND_3BUTTONS =
3120
Const
LEFT_POSITION_3RD_3BUTTONS =
4680
Select
Case
Buttons
Case
MB_OK
cmdButton2.Left
=
LEFT_POSITION_1ST_1BUTTON
cmdButton2.Caption
=
MB_TEXT_OK
cmdButton1.Visible
=
False
cmdButton2.Visible
=
True
cmdButton3.Visible
=
False
Case
MB_OKCANCEL
cmdButton1.Left
=
LEFT_POSITION_1ST_2BUTTONS
cmdButton2.Left
=
LEFT_POSITION_2ND_2BUTTONS
cmdButton1.Caption
=
MB_TEXT_OK
cmdButton2.Caption
=
MB_TEXT_CANCEL
cmdButton1.Visible
=
True
cmdButton2.Visible
=
True
cmdButton3.Visible
=
False
Case
MB_RETRYCANCEL
cmdButton1.Left
=
LEFT_POSITION_1ST_2BUTTONS
cmdButton2.Left
=
LEFT_POSITION_2ND_2BUTTONS
cmdButton1.Caption
=
MB_TEXT_RETRY
cmdButton2.Caption
=
MB_TEXT_CANCEL
cmdButton1.Visible
=
True
cmdButton2.Visible
=
True
cmdButton3.Visible
=
False
Case
MB_YESNO
cmdButton1.Left
=
LEFT_POSITION_1ST_2BUTTONS
cmdButton2.Left
=
LEFT_POSITION_2ND_2BUTTONS
cmdButton1.Caption
=
MB_TEXT_YES
cmdButton2.Caption
=
MB_TEXT_NO
cmdButton1.Visible
=
True
cmdButton2.Visible
=
True
cmdButton3.Visible
=
False
Case
MB_YESNOCANCEL
cmdButton1.Left
=
LEFT_POSITION_1ST_3BUTTONS
cmdButton2.Left
=
LEFT_POSITION_2ND_3BUTTONS
cmdButton3.Left
=
LEFT_POSITION_3RD_3BUTTONS
cmdButton1.Caption
=
MB_TEXT_YES
cmdButton2.Caption
=
MB_TEXT_NO
cmdButton3.Caption
=
MB_TEXT_CANCEL
cmdButton1.Visible
=
True
cmdButton2.Visible
=
True
cmdButton3.Visible
=
True
End
Select
Select
Case
DefaultButton
Case
MB_DEFBUTTON1
cmdButton1.Default
=
True
Case
MB_DEFBUTTON2
cmdButton2.Default
=
True
Case
MB_DEFBUTTON3
cmdButton3.Default
=
True
End
Select
End
Sub
Private
Sub
Form_Timer
(
)
'*********************************************************
' Procédure de l'événement Timer
'*********************************************************
Static
I As
Integer
Dim
strMessage As
String
If
m_strMessageAutoClose =
DEFAULT_MSG_AUTOCLOSE Then
strMessage =
m_strMessageAutoClose &
m_lngTimeOut -
I &
IIf
(
m_lngTimeOut -
I =
1
, " seconde"
, " secondes"
)
Else
strMessage =
m_strMessageAutoClose &
" ("
&
DEFAULT_MSG_AUTOCLOSE &
m_lngTimeOut -
I &
_
IIf
(
m_lngTimeOut -
I =
1
, " seconde )"
, " secondes )"
)
End
If
I =
I +
1
lblCloseMessage.Caption
=
strMessage
If
I >
m_lngTimeOut Then
I =
0
ExecuteMsgBoxProcedure
End
If
End
Sub
Private
Sub
ExecuteMsgBoxProcedure
(
)
'*********************************************************
' Procédure appelée par l'événement Timer qui exécute une tâche que vous déterminez...
' Vous remplacez donc les MsgBox() par votre propre procédure
'*********************************************************
Select
Case
m_lngButtons
Case
MB_OK
Msgbox
"1er bouton (OK)"
DoCmd.Close
acForm, Me.Name
Case
MB_OKCANCEL
Select
Case
m_lngDefaultButton
Case
MB_DEFBUTTON1
Msgbox
"1er bouton (OK)"
Case
MB_DEFBUTTON2
Msgbox
"2e bouton (ANNULER)"
DoCmd.Close
acForm, Me.Name
End
Select
Case
MB_RETRYCANCEL
Select
Case
m_lngDefaultButton
Case
MB_DEFBUTTON1
Msgbox
"1er bouton (RECOMMENCER)"
Case
MB_DEFBUTTON2
Msgbox
"2e bouton (ANNULER)"
DoCmd.Close
acForm, Me.Name
End
Select
Case
MB_YESNO
Select
Case
m_lngDefaultButton
Case
MB_DEFBUTTON1
Msgbox
"1er bouton (OUI)"
Case
MB_DEFBUTTON2
Msgbox
"2e bouton (NON)"
End
Select
Case
MB_YESNOCANCEL
Select
Case
m_lngDefaultButton
Case
MB_DEFBUTTON1
Msgbox
"1er bouton (OUI)"
Case
MB_DEFBUTTON2
Msgbox
"2e bouton (NON)"
Case
MB_DEFBUTTON3
Msgbox
"3e bouton (ANNULER)"
DoCmd.Close
acForm, Me.Name
End
Select
End
Select
End
Sub
Vous remarquerez que de nombreuses constantes sont utilisées dans ce bloc de code et pourtant, ne sont pas déclarées au sein de celui-ci.
Cela est tout à fait normal puisque ces dernières sont déclarées dans un module séparé que j'ai nommé basVariables et que vous alimenterez comme suit :
Option
Compare Database
Option
Explicit
Public
Const
MB_ICONEXCLAMATION =
&
H30&
Public
Const
MB_ICONINFORMATION =
&
H40&
Public
Const
MB_ICONQUESTION =
&
H20&
Public
Const
MB_ICONSTOP =
&
H10&
Public
Const
MB_ICON_NONE =
&
H0&
Public
Const
MB_DEFBUTTON1 =
&
H0&
Public
Const
MB_DEFBUTTON2 =
&
H100&
Public
Const
MB_DEFBUTTON3 =
&
H200&
Public
Const
MB_OK =
&
H0&
Public
Const
MB_OKCANCEL =
&
H1&
Public
Const
MB_RETRYCANCEL =
&
H5&
Public
Const
MB_YESNO =
&
H4&
Public
Const
MB_YESNOCANCEL =
&
H3&
Public
Const
SEPARATOR =
"|"
'Combinaison : ALT GR + 6
Public
Const
DEFAULT_MSG_AUTOCLOSE As
String
=
"Ce message va se fermer dans "
IV-B. Comment fonctionne l'affichage du message ?▲
L'affichage du message dépend exclusivement du contenu du paramètre OpenArgs.
Le paramètre OpenArgs sert à définir la propriété OpenArgs du formulaire.
Bon, je sais, ce n'est pas très parlant…
En fait, ce paramètre peut être utilisé par du code dans le module du formulaire qui est appelé et vous pouvez y loger une condition ou une chaîne de caractères que vous pouvez exploiter ensuite.
Dans notre cas, on l'utilise pour y loger l'ensemble des informations nécessaires à l'affichage du MsgBox() comme nous le souhaitons en affectant les différentes valeurs à des variables que nous contrôlons dans l'événement Form_Load().
IV-C. Explication sur la décomposition de la chaîne OpenArgs▲
Pour décomposer la chaîne de caractères contenue dans l'argument OpenArgs, nous utilisons la fonction Split().
La fonction Split() n'est utilisable qu'à partir de la version 2000 d'Access.
Pour exploiter un équivalent à cette fonction dans la version 97 d'Access, veuillez vous rendre dans la FAQ ici.
Le tableau de Strings comporte huit éléments respectivement détaillés ci-dessous :
- strMessage => élément 0 contenant le Message à afficher ;
- strIcons => élément 1 contenant l'Icône à afficher ;
- strButtons => élément 2 contenant les Boutons à afficher ;
- strDefault => élément 3 déterminant le bouton par Défaut ;
- strTitle => élément 4 contenant le Titre à afficher ;
- strCloseAuto => élément 5 déterminant si le formulaire s'autofermera (True ou False) ;
- strCloseDelay => élément 6 contenant le Délai en secondes permettant la fermeture du formulaire ;
- strMessageAutoClose => élément 7 contenant le message d'autofermeture à afficher.
Dans la section Form_Load(), cet argument est vérifié puis décomposé selon la position de chaque élément séparé par un séparateur nommé SEPARATOR qui est déclaré dans le module basVariables.
Ensuite, des sous-procédures telles que subShowIcon() et subShowButtons() sont appelées pour afficher et positionner icône et boutons.
Enfin, les contrôles Label reçoivent le texte défini dans les variables strMessage et strMessageAutoClose quant au Titre, il reçoit le contenu de strTitle.
V. Exemples d'utilisation▲
Pour vous montrer le résultat obtenu, je vous propose deux cas typiques, à savoir un formulaire MsgBox() classique où l'utilisateur doit intervenir et le même cas de figure avec une temporisation fixée à 10 secondes où le formulaire exécutera le clic sur le bouton qui est défini par défaut puis se fermera.
V-A. Message de confirmation attendant la réponse de l'utilisateur▲
Voyez ici le formulaire MsgBox() : il est très ressemblant à ce que renvoie la fonction du même nom.
V-B. Message de confirmation s'autofermant au bout de 10 secondes▲
VI. Mise en œuvre d'un exemple concret▲
Pour illustrer le côté pratique de l'utilisation des formulaires temporisés sous forme de MsgBox(), je vais vous montrer ci-après deux exemples.
VI-A. Impression d'un état▲
Exemple A qui illustre l'impression d'un état en mode aperçu.
Pour mettre en œuvre ce processus, il suffit d'appeler la procédure qui affiche le formulaire précédée de l'appel de la fonction DoCmd.OpenReport.
Private
Sub
cmdShowInvoice_Click
(
)
PreviewReport "Facture 4"
ConfirmPrint
End
Sub
Private
Sub
ConfirmPrint
(
)
Dim
strIcons As
String
Dim
strButtons As
String
Dim
strDefault As
String
Dim
strMessage As
String
Dim
strTitle As
String
Dim
strCloseAuto As
String
Dim
strCloseDelay As
String
Dim
strArgs As
String
Dim
strMessageAutoClose As
String
strMessage =
"La facture recherchée est maintenant affichée à l'écran..."
&
vbCrLf
&
vbCrLf
&
"Voulez-vous l'imprimer"
strIcons =
MB_ICONQUESTION
strButtons =
MB_YESNO
strDefault =
MB_DEFBUTTON1
strTitle =
"Impression automatique de la facture"
strCloseAuto =
"True"
strCloseDelay =
"10"
strMessageAutoClose =
"L'impression va être lancée : "
strArgs =
strMessage &
SEPARATOR &
strIcons &
SEPARATOR &
strButtons &
SEPARATOR &
strDefault &
_
SEPARATOR &
strTitle &
SEPARATOR &
strCloseAuto &
SEPARATOR &
strCloseDelay &
SEPARATOR &
_
strMessageAutoClose
DoCmd.OpenForm
"frmMsgbox"
, acNormal, , , , acDialog, strArgs
End
Sub
La procédure PreviewReport() est une procédure publique créée qui comme son nom l'indique affiche un état en mode aperçu.
VI-B. Fermeture de la base de données▲
Exemple B qui illustre la fermeture de la base de données…
Private
Sub
cmdQuitDB_Click
(
)
ConfirmQuitDatabase
End
Sub
Private
Sub
ConfirmQuitDatabase
(
)
Dim
strIcons As
String
Dim
strButtons As
String
Dim
strDefault As
String
Dim
strMessage As
String
Dim
strTitle As
String
Dim
strCloseAuto As
String
Dim
strCloseDelay As
String
Dim
strArgs As
String
Dim
strMessageAutoClose As
String
strMessage =
"La base de données n'a pas été utilisée pendant plus d'une heure..."
&
vbCrLf
&
_
"Afin d'économiser des ressources, celle-ci doit être fermée dans ce cas."
&
vbCrLf
&
vbCrLf
&
_
"Confimez-vous la fermeture ?"
strIcons =
MB_ICONEXCLAMATION
strButtons =
MB_OKCANCEL
strDefault =
MB_DEFBUTTON1
strTitle =
"Fermeture automatique de la base"
strCloseAuto =
"True"
strCloseDelay =
"30"
strMessageAutoClose =
"La base va être fermée : "
strArgs =
strMessage &
SEPARATOR &
strIcons &
SEPARATOR &
strButtons &
SEPARATOR &
strDefault &
_
SEPARATOR &
strTitle &
SEPARATOR &
strCloseAuto &
SEPARATOR &
strCloseDelay &
SEPARATOR &
_
strMessageAutoClose
DoCmd.OpenForm
"frmMsgbox"
, acNormal, , , , acDialog, strArgs
End
Sub
Il ne vous restera plus qu'à affecter aux boutons du formulaire MsgBox() les procédures à exécuter.
- Dans l'exemple A ci-avant, vous auriez affecté la procédure d'impression au bouton Oui et l'opération de fermeture de l'état suivie de l'ouverture du formulaire appelant pour le bouton Non.
- Dans l'exemple B ci-avant, vous auriez affecté la procédure qui quitte l'application au bouton OK et l'opération de fermeture du formulaire suivie de l'ouverture du formulaire principal ou le menu pour le bouton Non.
VII. Usage d'une fonction pour appeler le formulaire▲
Il peut être intéressant de disposer d'une fonction pour appeler le formulaire comme si l'on utilisait la fonction Visual Basic MsgBox().
Malheureusement, du fait que j'exploite ici la fonction DoCmd.OpenForm(), il n'est pas facile de retourner un résultat pour intercepter la réponse manuelle de l'utilisateur ou celle du Timer selon que l'appel est temporisé ou non…
Pour pallier cela, j'ai donc utilisé une Propriété (Property) de type Integer qui va prendre la valeur correspondant au bouton sélectionné.
De là, je peux alors capturer ladite valeur et exécuter ce que je souhaite derrière.
VII-A. Création d'un module dédié▲
Pour ce faire, j'ai donc créé un module (basMessageBox) dans lequel j'ai logé une procédure MessageBox() qui fait office de fonction d'appel du formulaire. Cette procédure est utilisée dans une procédure de test nommée pour la circonstance TestMessageBox().
Dans ce test, j'appelle l'ouverture du formulaire « frmMessageBox » et pose une boucle qui vérifie son affichage. Tant qu'il est affiché, la variable blnWaitingClose reste vraie (True). Cette vérification est effectuée par la fonction formIsLoaded.
Une fois qu'elle prend la valeur False, je teste alors la valeur de la propriété pIntMessageAnswer et agis en conséquence.
Option
Compare Database
Option
Explicit
Public
cAnswer As
clsMessageBox
Public
Sub
MessageBox
(
ByVal
FormMsgBoxName As
String
, _
ByVal
Message As
String
, _
Optional
ByVal
Title As
String
=
"Message"
, _
Optional
ByVal
Icon As
Integer
=
MB_ICON_NONE, _
Optional
ByVal
Buttons As
Integer
=
MB_OK, _
Optional
ByVal
DefaultButton As
Integer
=
MB_DEFBUTTON1, _
Optional
ByVal
CloseAuto As
Boolean
=
False
, _
Optional
ByVal
CloseDelay As
Long
=
0
, _
Optional
ByVal
MessageAutoClose As
String
=
DEFAULT_MSG_AUTOCLOSE)
'*********************************************************
' Procédure permettant l'appel du formulaire frmMsgBox comme la fonction
'*********************************************************
Dim
strArgs As
String
strArgs =
Message &
SEPARATOR &
Icon &
SEPARATOR &
Buttons &
SEPARATOR &
DefaultButton &
_
SEPARATOR &
Title &
SEPARATOR &
CloseAuto &
SEPARATOR &
CloseDelay &
SEPARATOR &
_
MessageAutoClose
DoCmd.OpenForm
FormMsgBoxName, acNormal, , , , acDialog, strArgs
End
Sub
Sub
TestMessageBox
(
)
'*********************************************************
' Test de l'appel du formulaire frmMsgBox comme une fonction
'*********************************************************
Const
MESSAGE_TEST =
"La base de données n'a pas été utilisée pendant plus d'une heure..."
&
vbCrLf
&
_
"Afin d'économiser des ressources, celle-ci doit être fermée dans ce cas."
_
&
vbCrLf
&
vbCrLf
&
"Confimez-vous la fermeture ?"
Dim
blnWaitingClose As
Boolean
Set
cAnswer =
New
clsMessageBox
MessageBox "frmMessageBox"
, MESSAGE_TEST, "Fermeture automatique de la Base"
, _
MB_ICONEXCLAMATION, MB_YESNO, MB_DEFBUTTON2, True
, 30
, "La base va être fermée : "
Do
blnWaitingClose =
formIsLoaded
(
"frmMessageBox"
)
Loop
Until
blnWaitingClose =
False
Select
Case
cAnswer.pIntMessageAnswer
Case
vbYes
Set
cAnswer =
Nothing
Application.Quit
acQuitSaveNone
Case
vbNo
Set
cAnswer =
Nothing
OpenForm "frmMainMenu"
, acWindowNormal
End
Select
End
Sub
Private
Function
formIsLoaded
(
ByVal
FormName As
String
) As
Boolean
'*********************************************************
' Fonction permettant de vérifier qu'un formulaire est ouvert
'*********************************************************
Const
IS_LOADED =
1
Const
IS_CLOSED =
0
Const
conModeCréation =
0
If
SysCmd
(
acSysCmdGetObjectState, acForm, FormName) <>
IS_CLOSED Then
formIsLoaded =
(
Forms
(
FormName).CurrentView
=
IS_LOADED)
End
If
End
Function
VII-B. Création d'un formulaire frmMessageBox dédié▲
Pour créer un formulaire frmMessageBox dédié, j'ai tout simplement dupliqué le formulaire et j'ai adapté le code comme suit :
Option
Compare Database
Option
Explicit
Private
Const
MB_TEXT_OK =
"&OK"
Private
Const
MB_TEXT_CANCEL =
"&Annuler"
Private
Const
MB_TEXT_RETRY =
"&Recommencer"
Private
Const
MB_TEXT_YES =
"&Oui"
Private
Const
MB_TEXT_NO =
"&Non"
Private
m_lngTimeOut As
Long
Private
m_strMessageAutoClose As
String
Private
m_lngDefaultButton As
Long
Private
m_lngButtons As
Long
Private
Sub
cmdButton1_Click
(
)
'*********************************************************
' Procédure Click du bouton 1
' Vous remplacez donc les MsgBox() par votre propre procédure
'*********************************************************
Select
Case
cmdButton1.Caption
Case
MB_TEXT_OK
cAnswer.pIntMessageAnswer
=
vbOK
Case
MB_TEXT_YES
cAnswer.pIntMessageAnswer
=
vbYes
Case
MB_TEXT_RETRY
cAnswer.pIntMessageAnswer
=
vbRetry
End
Select
DoCmd.Close
acForm, Me.Name
End
Sub
Private
Sub
cmdButton2_Click
(
)
'*********************************************************
' Procédure Click du bouton 2
' Vous remplacez donc les MsgBox() par votre propre procédure
'*********************************************************
Select
Case
cmdButton2.Caption
Case
MB_TEXT_NO
cAnswer.pIntMessageAnswer
=
vbNo
Case
MB_TEXT_CANCEL
cAnswer.pIntMessageAnswer
=
vbCancel
End
Select
DoCmd.Close
acForm, Me.Name
End
Sub
Private
Sub
cmdButton3_Click
(
) 'Always Cancel
'*********************************************************
' Procédure Click du bouton 3
' Vous remplacez donc les MsgBox() par votre propre procédure
'*********************************************************
cAnswer.pIntMessageAnswer
=
vbCancel
DoCmd.Close
acForm, Me.Name
End
Sub
Private
Sub
Form_Load
(
)
''*********************************************************
' Procédure Form_Load
'*********************************************************
Const
FORM_HEIGHT_WITH_AUTOCLOSE As
Integer
=
1760
Const
FORM_HEIGHT_WITHOUT_AUTOCLOSE As
Integer
=
2000
Const
LABEL_HEIGHT_WITH_AUTOCLOSE As
Integer
=
225
Const
LABEL_HEIGHT_WITHOUT_AUTOCLOSE As
Integer
=
0
Dim
strMessage As
String
Dim
intIcons As
Integer
Dim
strTitle As
String
Dim
blnCloseAuto As
Boolean
Dim
straArgs
(
) As
String
' ----> Contrôle du contenu de OpenArgs (Tableau de string de 8 éléments)
' ----> Affectation des éléments du tableau aux variables
If
Not
IsNull
(
Me.OpenArgs
) Then
straArgs =
Split
(
Me.OpenArgs
, SEPARATOR)
strMessage =
straArgs
(
0
)
intIcons =
CInt
(
straArgs
(
1
))
m_lngButtons =
CLng
(
straArgs
(
2
))
m_lngDefaultButton =
CLng
(
straArgs
(
3
))
strTitle =
straArgs
(
4
)
blnCloseAuto =
CBool
(
straArgs
(
5
))
m_lngTimeOut =
straArgs
(
6
)
m_strMessageAutoClose =
IIf
(
Len
(
straArgs
(
7
)), straArgs
(
7
), IIf
(
m_lngTimeOut, DEFAULT_MSG_AUTOCLOSE, ""
))
' ----> Redimensionnement du formulaire si AutoClose n'est pas utilisé
If
m_lngTimeOut Then
Me.lblCloseMessage.Height
=
LABEL_HEIGHT_WITH_AUTOCLOSE
Me.InsideHeight
=
FORM_HEIGHT_WITHOUT_AUTOCLOSE
Else
Me.lblCloseMessage.Height
=
LABEL_HEIGHT_WITHOUT_AUTOCLOSE
Me.InsideHeight
=
FORM_HEIGHT_WITH_AUTOCLOSE
End
If
Else
' ----> OpenArgs est vide (Tentative d'ouverture du formulaire seul)
Msgbox
"Impossible d'afficher le message !"
, 48
, "Erreur interne"
DoCmd.Close
acForm, Me.Name
On
Error
Resume
Next
DoCmd.OpenForm
"frmDiplayer"
, acNormal, , , , acDialog
Exit
Sub
End
If
' ----> Initialisation du Timer à 1 seconde selon le cas
If
blnCloseAuto Then
Me.TimerInterval
=
1000
Else
Me.TimerInterval
=
0
End
If
' ----> Affectation des variables aux contrôles
lblCloseMessage.Caption
=
vbNullString
subShowIcon intIcons
subShowButtons m_lngButtons, m_lngDefaultButton
Caption =
strTitle
Me!lblMessage.Caption
=
strMessage
End
Sub
Private
Sub
subShowIcon
(
ByVal
Icon As
Integer
)
'*********************************************************
' Procédure d'affectation de l'image à l'icône selon la valeur de Icon
'*********************************************************
Select
Case
Icon
Case
MB_ICONEXCLAMATION
imgIcon.Picture
=
Me!imgExclamation.Picture
Case
MB_ICONINFORMATION
imgIcon.Picture
=
Me!imgInformation.Picture
Case
MB_ICONQUESTION
imgIcon.Picture
=
Me!imgQuestion.Picture
Case
MB_ICONSTOP
imgIcon.Picture
=
Me!imgStop.Picture
End
Select
End
Sub
Private
Sub
subShowButtons
(
ByVal
Buttons As
Long
, ByVal
DefaultButton As
Integer
)
'*********************************************************
' Procédure de positionnement des boutons selon la valeur de Buttons et DefaultButton
'*********************************************************
Const
LEFT_POSITION_1ST_1BUTTON =
3295
Const
LEFT_POSITION_1ST_2BUTTONS =
2475
Const
LEFT_POSITION_2ND_2BUTTONS =
4020
Const
LEFT_POSITION_1ST_3BUTTONS =
1560
Const
LEFT_POSITION_2ND_3BUTTONS =
3120
Const
LEFT_POSITION_3RD_3BUTTONS =
4680
Select
Case
Buttons
Case
MB_OK
cmdButton2.Left
=
LEFT_POSITION_1ST_1BUTTON
cmdButton2.Caption
=
MB_TEXT_OK
cmdButton1.Visible
=
False
cmdButton2.Visible
=
True
cmdButton3.Visible
=
False
Case
MB_OKCANCEL
cmdButton1.Left
=
LEFT_POSITION_1ST_2BUTTONS
cmdButton2.Left
=
LEFT_POSITION_2ND_2BUTTONS
cmdButton1.Caption
=
MB_TEXT_OK
cmdButton2.Caption
=
MB_TEXT_CANCEL
cmdButton1.Visible
=
True
cmdButton2.Visible
=
True
cmdButton3.Visible
=
False
Case
MB_RETRYCANCEL
cmdButton1.Left
=
LEFT_POSITION_1ST_2BUTTONS
cmdButton2.Left
=
LEFT_POSITION_2ND_2BUTTONS
cmdButton1.Caption
=
MB_TEXT_RETRY
cmdButton2.Caption
=
MB_TEXT_CANCEL
cmdButton1.Visible
=
True
cmdButton2.Visible
=
True
cmdButton3.Visible
=
False
Case
MB_YESNO
cmdButton1.Left
=
LEFT_POSITION_1ST_2BUTTONS
cmdButton2.Left
=
LEFT_POSITION_2ND_2BUTTONS
cmdButton1.Caption
=
MB_TEXT_YES
cmdButton2.Caption
=
MB_TEXT_NO
cmdButton1.Visible
=
True
cmdButton2.Visible
=
True
cmdButton3.Visible
=
False
Case
MB_YESNOCANCEL
cmdButton1.Left
=
LEFT_POSITION_1ST_3BUTTONS
cmdButton2.Left
=
LEFT_POSITION_2ND_3BUTTONS
cmdButton3.Left
=
LEFT_POSITION_3RD_3BUTTONS
cmdButton1.Caption
=
MB_TEXT_YES
cmdButton2.Caption
=
MB_TEXT_NO
cmdButton3.Caption
=
MB_TEXT_CANCEL
cmdButton1.Visible
=
True
cmdButton2.Visible
=
True
cmdButton3.Visible
=
True
End
Select
Select
Case
DefaultButton
Case
MB_DEFBUTTON1
cmdButton1.Default
=
True
Case
MB_DEFBUTTON2
cmdButton2.Default
=
True
Case
MB_DEFBUTTON3
cmdButton3.Default
=
True
End
Select
End
Sub
Private
Sub
Form_Timer
(
)
'*********************************************************
' Procédure de l'événement Timer
'*********************************************************
Static
I As
Integer
Dim
strMessage As
String
If
m_strMessageAutoClose =
DEFAULT_MSG_AUTOCLOSE Then
strMessage =
m_strMessageAutoClose &
m_lngTimeOut -
I &
IIf
(
m_lngTimeOut -
I =
1
, " seconde"
, " secondes"
)
Else
strMessage =
m_strMessageAutoClose &
" ("
&
DEFAULT_MSG_AUTOCLOSE &
m_lngTimeOut -
I &
_
IIf
(
m_lngTimeOut -
I =
1
, " seconde )"
, " secondes )"
)
End
If
I =
I +
1
lblCloseMessage.Caption
=
strMessage
If
I >
m_lngTimeOut Then
I =
0
ExecuteMsgBoxProcedure
End
If
End
Sub
Private
Sub
ExecuteMsgBoxProcedure
(
)
'*********************************************************
' Procédure appelée par l'événement Timer qui exécute une tâche que vous déterminez...
' Vous remplacez donc les MsgBox() par votre propre procédure
'*********************************************************
Select
Case
m_lngButtons
Case
MB_OK
cAnswer.pIntMessageAnswer
=
vbOK
Case
MB_OKCANCEL
Select
Case
m_lngDefaultButton
Case
MB_DEFBUTTON1
cAnswer.pIntMessageAnswer
=
vbOK
Case
MB_DEFBUTTON2
cAnswer.pIntMessageAnswer
=
vbCancel
End
Select
Case
MB_RETRYCANCEL
Select
Case
m_lngDefaultButton
Case
MB_DEFBUTTON1
cAnswer.pIntMessageAnswer
=
vbRetry
Case
MB_DEFBUTTON2
cAnswer.pIntMessageAnswer
=
vbCancel
End
Select
Case
MB_YESNO
Select
Case
m_lngDefaultButton
Case
MB_DEFBUTTON1
cAnswer.pIntMessageAnswer
=
vbYes
Case
MB_DEFBUTTON2
cAnswer.pIntMessageAnswer
=
vbNo
End
Select
Case
MB_YESNOCANCEL
Select
Case
m_lngDefaultButton
Case
MB_DEFBUTTON1
cAnswer.pIntMessageAnswer
=
vbYes
Case
MB_DEFBUTTON2
cAnswer.pIntMessageAnswer
=
vbNo
Case
MB_DEFBUTTON3
cAnswer.pIntMessageAnswer
=
vbCancel
End
Select
End
Select
DoCmd.Close
acForm, Me.Name
End
Sub
Vous remarquerez en fait que là où étaient logées les instructions
Msgbox
1er bouton (
OK)...
j'ai écrit à la place la correspondance de la valeur renvoyée,
cAnswer.pIntMessageAnswer
=
vbOK
soit pour ce dernier cas, la propriété pIntMessageAnswer qui prend alors la valeur renvoyée par le bouton « équivalente » à celle de la fonction Visual Basic MsgBox().
VII-C. Création d'un module de classe clsMessageBox dédié▲
Pour exploiter la propriété pIntMessageAnswer, j'ai ajouté un Module de classe spécifique que j'ai nommé clsMessageBox où se trouve cette dernière.
il est vrai qu'il était possible d'utiliser une variable publique en guise de propriété, mais cette convention est plus propre.
Option
Compare Database
Option
Explicit
Private
m_IntMessageAnswer As
Integer
Public
Property
Get
pIntMessageAnswer
(
) As
Integer
pIntMessageAnswer =
m_IntMessageAnswer
End
Property
Public
Property
Let
pIntMessageAnswer
(
ByVal
MessageAnswer As
Integer
)
m_IntMessageAnswer =
MessageAnswer
End
Property
VIII. Conclusion▲
Ce tutoriel peut s'avérer utile pour les développeurs qui souhaitent automatiser les actions sur les formulaires.
Pour illustrer ce tutoriel, j'ai pris expressément un MsgBox() puisqu'il répond dans la plupart des cas aux besoins des développeurs, mais rien ne vous empêche de transposer les exemples de celui-ci pour d'autres formulaires plus spécifiques.
Ce tutoriel, plus théorique que pratique, permet de répondre à des questions qui sont parfois soulevées dans le forum
(Comment créer un formulaire MsgBox(), comment ôter les beeps d'un MsgBox(),etc.)
Je vous laisse vous entraîner avec cette pratique. Si vous rencontrez des difficultés ou si j'ai omis de préciser quelque chose qui reste obscur, n'hésitez pas à m'en faire part.