Autant la sélection automatique d’un item dans une liste modifiable est facile grâce à une simple affectation, autant avec une liste classique c’est plus compliqué.
Je vous livre l’astuce consistant à mettre un peu de code dans une liste déroulante reprenant les valeurs de la liste.
Dans l’événement Après MAJ de la liste déroulante ou d’une zone de texte mettre le code VBA ci-dessous :
Dim i As Long
Dim i_save As Long
Me.lstMultiple.Selected(0) = True 'désélection de la liste multiple
For i = 1 To Me.lstMultiple.ListCount - 1 'parcours la liste multiple Me.lstMultiple.Selected(i) = False 'déselection de l'élement courant
If (Me.lstMultiple.ItemData(i) = CStr(Nz(Me.lstRecherche, ""))) Then
's'il est identique à ce que je cherche
i_save = i 'je repère la ligne
End If
Next
Me.lstMultiple.Selected(i_save) = True 'en sortant je sélectionne la liste
lstMultiple est la liste classique et lstRecherche est la liste modifiable ou la zone de texte ou vous sélectionnez la valeur à trouver.
L’astuce consiste à parcourir la liste à la recherche de la valeur, d’en capter l’indice de la ligne pour l’affecter à cette même liste.
Si vous utilisez des bibliothèques externes à MS Access, comprenez qui ne sont pas liées automatiquement à MS Access, cet article vous intéresse.
Earlybinding, vous l’utilisez systématiquement sans le savoir.
Pour utiliser une bibliothèque avec MS Access, habituellement on ouvre VBE, l’éditeur de VBA, et on utilise Outils/Références. La liste qui s’affiche dans cette fenêtre sont les bibliothèques disponibles sur le poste. Il suffit de cocher la bibliothèque que l’on souhaite utiliser.
Dans ce cas on utilise le Earlybinding qu’on peut traduire approximativement par liaison en amont. MS Access se comporte alors de la manière suivante. Au moment de l’ouverture de l’application et avant que la première ligne de code de l’application ne s’exécute, MS Access va vérifier que les bibliothèques requises existent. Il va sans dire qu’aucun contrôle n’est possible durant cette phase.
Cela occasionne des problèmes lorsque la bibliothèque n’est pas installée sur le poste cible ou qu’elle a une version différente. Dans ce cas, un message d’erreur s’affiche et l’application ne démarre pas.
Voici l’exemple d’un code en Earlybinding en relation avec la bibliothèque Microsoft Word x.xx Object Library :
Dim wApp As Word.Application
Dim oDoc As Word.Document 'crée l'objet Word
Set wApp = CreateObject("Word.Application")
wApp.Visible = False
Set oDoc = wApp.Documents.Open(Chemin)
With oDoc
.MailMerge.OpenDataSource Name:="c:\temp\export.csv" ...
On remarque que les objets sont fortement typés lors de leur déclaration.
Latebinding ou comment contrôler la présence des bibliothèques.
Heureusement, le langage VBA dispose de moyen de prévenir l’absence de la bibliothèque au moyen du Latebinding ou liaison tardive.
Avec le LateBinding la bibliothèque n’est plus déclarée avant, c’est à dire dans les références, mais bel et bien dans le code au moment de son utilisation. Les objets ne sont plus fortement typés mais reçoivent le type générique Object. De même éventuelles constantes ne sont plus disponibles, il faudra donc les recréer.
Voici un cas concret d’une transformation Early vers Late pour palier un problème de version d’Office lors d’une automation avec Word.
On recrée les constantes correspondantes à la bibliothèque Microsoft Office x.xx Object Library.
'Debug
'Dim wApp As Word.Application
'Dim oDoc As Word.Document
'Exploitation
Dim wApp As Object
Dim oDoc As Object
Set wApp = CreateObject("Word.Application")
wApp.Visible = False
Set oDoc = wApp.Documents.Open(Chemin)
With oDoc .MailMerge.OpenDataSource Name:="C:\export.csv" ...
.Close (wdDoNotSaveChanges)
Notez la mise en commentaires des lignes Earlybinding pour permettre une maintenance/évolution facilité.
Cette technique permet, dans la limite de la compatibilité des bibliothèques, de déployer l’application sur n’importe quel Office puisque le code n’est plus attaché à une version unique de Word.
Dans les références on peut se passer de la déclaration comme on peut le voir ci-dessous.
Voici un cas concret d’une vérification de présence de Word lors de l’ouverture d’un formulaire.
Robustesse du code par la prévention d’erreur
En mode LateBinding il peut arriver que le composant soit absent du système. C’est pour cette raison qu’il faut tester le composant avant son utilisation. L’exemple suivant montre comment tester un composant.
Public Function OpenWord() as Boolean
On Error GoTo ErrSub
Dim wApp As Object
Set wApp = CreateObject("Word.Application")
Set wApp = Nothing
Exit Function
ErrSub:
If Err.Number = 429 Then
MsgBox "Vous devez disposer de Word pour utiliser cette fonctionnalité."
vComposant = False
End If
End Function
L’erreur 429 est remontée lorsqu’une bibliothèque est absente.
Conclusion
Si le LateBinding est préférable pour une application en exploitation, il n’en va pas de même lors du développement. En effet le Earlybinding donne accès à l’autocomplétion, ce qui est un confort non négligeable dans cette phase du projet.
Cette fois-ci je vous livre l’une de mes astuces que j’utilise systématiquement dans toutes mes applications : Afficher/Cacher le ruban à la demande.
La méthode est simple, une variable globale permet de fixer l’état du ruban. Un raccourci dans une macro Autokey permet de changer l’état du ruban et une fonction VBA affiche ou cache le ruban suivant l’état de la variable.
Option Compare Database
Option Explicit
Dim StateRibbon As Boolean
Function DisplayRibbon()
' Auteur : Fabrice CONSTANS (MVP)
' Description : Affiche/cache le ruban
' ctrl+shift+R
Nz StateRibbon, False
' 1er passage initialise à faux
' (ribbon invisible)
DoCmd.ShowToolbar "Ribbon", IIf(StateRibbon, acToolbarNo, acToolbarYes)
StateRibbon = Not StateRibbon ' inverse la valeur
End Function
Le raccourci :
+^{R} ExecuterCode DisplayRibbon()
Cacher le ruban permet de cacher également les boutons Restaurer/ Fermer ce qui donne une touche professionnelle à l’application.
Dans la rubrique d’assistance à la maintenance d’application voici un bout de code à coupler à une macro AutoKeys.
Lorsque vous devez intervenir sur une vieille application ou une application volumineuse, ce code vous rendra le service de ne pas avoir à chercher le formulaire et le contrôle actif parmi les multitudes de bibliothèques et de formulaires ou états. Cerise sur le gâteau si vous ouvrez l’éditeur VBA vous serez automatiquement positionné sur son module.
Son fonctionnement est simple ; Il repère le nom retourné par Screen.Activeform et Screen. Activecontrole et essaye de trouver le code dans le VBE components.
Function msgNameBase()
' Auteur : Fabrice CONSTANS MVP
' Description : renvoie le nom : de l'objet, de la base pour l'objet
' actif
On Error GoTo Err_msgNomBase
Dim strNomBase As String
Dim sCurfrm As String, sExt As String
Dim sCurControle As String
Dim i As Integer
sExt = "form_" ' c'est un formulaire par défaut.
' recupère le nom du forms, si c'est un report ' il part en erreur (voir traitement des erreurs)
sCurfrm = Screen.ActiveForm.Name
sCurControle = Screen.ActiveControl.Name
' si le nom n'existe pas (voir erreur)
Curfrm = Application.VBE.VBProjects(i).VBComponents(sExt & _ sCurfrm).Name
GoTo Exit_msgNomBase Err_msgNomBase:
' TRAITEMENT POUR UN ETAT.
If Err = 2475 Then
' ce n'est pas un form (2476 ce n'est pas un report)
' on capture le nom du report sCurfrm = Screen.ActiveReport.Name
' le prefixe pour un report
sExt = "Report_" Resume Next
' on continue
ElseIf Err = 9 Then
'Erreur
i = i + 1
If i > Application.VBE.VBProjects.Count Then
MsgBox "Impossible de trouver " & sCurfrm & _ " dans l'application."
Exit Function
End If
Resume
ElseIf Err > 0 Then
MsgBox "Erreur non prévue :" & Err.Number & "---" & _ Err.Description
Exit Function
End If
Exit_msgNomBase:
MsgBox IIf(sExt = "form_", "Forms", "Report") & " : " & _ sCurfrm & vbCrLf & _ "Controle : " & sCurControle & vbCrLf & _ "Base : " & Application.VBE.VBProjects(i).Name
End Function
L’intérêt est évidemment de pouvoir le déclencher n’importe quand dans l’IHM, c’est pour cela qu’il faut le coupler à une macro AutoKeys.
Lorsque vous utilisez une zone de liste sans sélection multiple, il peut arriver d’avoir besoin de désélectionner la ligne. Inutile de vous acharner sur la ligne sélectionnée avec votre souris, elle restera en surbrillance.
Je vous livre ici ma méthode pour enlever la sélection :
Dim itSel As Integer
Private Sub Form_Open(Cancel As Integer)
'initialise à -1 pour ne pas perturber la première sélection
itSel = -1
End Sub
Private Sub Liste_Click()
'la selection est identique à la précédent
If Me.Liste.ListIndex = itSel Then
Me.Liste.ListIndex = -1
'on déselectionne itSel = -1
Else
'on fixe le choix pour la prochaine comparaison
itSel = Me.Liste.ListIndex
End If
End Sub
La liste se nomme Liste. On déclare une variable globale au formulaire, que l’on nomme itSel, elle permettra de conserver le précédent choix opéré, soit un entier positif pour une sélection et -1 pour la dé-sélection.
Sur l’ouverture du formulaire on considère que rien n’est sélectionné et on attribue la valeur -1 à itSel. Lorsqu’on clique sur la zone de liste, on vérifie si le clic correspond à la sélection en cours au moyen de la propriété ListIndex.
Cette propriété retourne un entier de 0 à x ou x est le dernier item de la liste. Lorsque qu’on attribue une valeur à ListIndex l’item correspond est sélectionné, par contre si l’on met -1 aucune ligne n’est sélectionnée.
Mes développements me confrontent souvent à des applications volumineuses où le code prend une place importante. Dans ce cas, et tant que l’application n’est pas compilée (mde / accde), l’éditeur Visual Basic ou VBE (Alt-F11) ouvre toutes les fenêtres de code y compris celles des bibliothèques non compilées ou non protégées.
Ce comportement se produit également lors de l’exécution de l’application même si l’éditeur VBA n’est pas ouvert. Cela encombre la pile GDI de Windowsjusqu’à saturation de celle-ci. J’ai donc créé un bout de code pour refermer les fenêtres de code.
Public Function CloseAllVbeWindows()
' Auteur : Fabrice CONSTANS MVP
' Ferme toutes les fenêtres du VBE
' permet de réduire les handles GDI et d'éviter la saturation mémoire.
Dim i As Integer
Dim j As Integer
On Error Resume Next
For i = 1 To Application.VBE.VBProjects.Count
For j = 1 To Application.VBE.VBProjects(i).VBE.Windows.Count
If Application.VBE.VBProjects(i).VBE.Windows(j).Type = vbext_wt_CodeWindow Then
' les fenetres de code
Application.VBE.VBProjects(i).VBE.Windows(j).Close
End If
Next
Next
Exit Function
End Function
Liste des constantes des fenêtres VBE
Valeur Numérique
Constante VBA
Description
0
vbext_wt_CodeWindow
Fenêtre de code
1
vbext_wt_Designer
Fenêtre de concepteur (UserForm)
2
vbext_wt_Browser
Explorateur de projet
3
vbext_wt_Watch
Fenêtre Espion
4
vbext_wt_Locals
Fenêtre Variables locales
5
vbext_wt_Immediate
Fenêtre Exécution immédiate
6
vbext_wt_ProjectWindow
Fenêtre Projet
7
vbext_wt_PropertyWindow
Fenêtre Propriétés
retrouvez toutes les options dans l’aide Microsoft
Vous pouvez appeler cette procédure après le chargement de votre application ou sur une macro AutoKeys.
Les modifications d’une application conséquente sont souvent difficiles à réaliser, surtout dans le cas des requêtes. Dans ce billet je vous propose un bout de code pour rechercher un mot, complet ou non, dans toutes les requêtes d’un fichier MS Access.
Function SnifQuery(Optional strText As String = "")
On Error GoTo errSub
Dim db As DAO.Database
Dim qry As DAO.QueryDef
Set db = CodeDb
' si rien n'est transmis on demande le mot
If strText = "" Then
strText = InputBox("Indiquez le mot à rechercher dans les requêtes." & _
vbCrLf & "Ce mot peut être incomplet.", "Mot à rechercher", "")
If strText = "" Then Exit Function
End If
' balaye toutes les requêtes
For Each qry In db.QueryDefs
'si on trouve le mot
If qry.sql Like "*" & strText & "*" Then
' on ouvre la requête
DoCmd.OpenQuery qry.Name, acViewDesign
End If
Next
' on est propre donc on ferme le chose dont on ne se sert plus.
Set qry = Nothing
Set db = Nothing
Exit Function
errSub:
Resume Next
End Function
Pour le lancement vous pouvez passer par la fenêtre Exécution de VBE ou encore créer une macro Autokeys.
Ouvrez une nouvelle macro.
Affichez la colonne Nom de macro.
Entrez le raccourci souhaité. Exemple +^{Q}
Dans la colonne Action sélectionnez ExécuterCode.
Indiquez dans le nom de la fonction SnifQuery().
Lorsque vous utiliserez Ctrl+Shift+Q la fonction sera appelée.
Attention ce bout de code ne fait pas de recherche dans les requêtes des bibliothèques.
Cette petite fonction sans prétention permet de transformer une chaine de caractères en valeur numérique. « Quoi de nouveau ! » me direz-vous ? A la différence des fonctions natives de types Val(), CDbl() et autre, cette fonction épure tous les caractères non numérique en tenant compte du signe et du séparateur décimal.
Function fSupprimerAlpha(mValeur As Variant) As Variant
'------------------------------------------------------
' Procedure : fSupprimerAlpha / Function
' Author : fabrice CONSTANS (MVP)
' Date : 03/06/2012 ' Modified :
' Description : épure une chaine de caractère pour retourner une valeur numérique
' tient compte du sép. décimal et des + et -
' Parameters : mValeur contient la valeur à transformer
' Return Value : retourne une valeur numérique valide
'------------------------------------------------------
Dim i As Integer
If IsNull(mValeur) Or Len(mValeur) = 0 Then
fSupprimerAlpha = Null
Exit Function
End If
' à inverser suivant le type de séparateur utilisé
mValeur = Replace(mValeur, ",", ".")
' supprime tous les caracteres alpha
For i = 1 To Len(mValeur)
' tout ce qui n'est pas numérique sauf +,- et sepérateur dec.
If Not IsNumeric(Mid(mValeur, i, 1)) And _
Not Mid(mValeur, i, 1) Like " *[,,.]*" And _
Not Mid(mValeur, i, 1) Like "*[+,-]*" Then
' remplace par un espace
mValeur = Replace(mValeur, Mid(mValeur, i, 1), " ")
End If
Next ' renvoi la nouvelle valeur sans les espaces
fSupprimerAlpha = Replace(mValeur, " ", "")
End Function
Vous pouvez facilement y faire appel depuis une requête par exemple.
Voici un petit code qui permet de formater une adresse postale. Il est à insérer en dessous des lignes d’options (Option Compare…) d’un module standard (pas dans un module de classe, formulaire ou état) :
Valeur saisie : 115, impasse de la petite reine Valeur formatée : 115, Impasse de la Petite Reine
Const particules= " de ; du ; d'; des ; l'; la ; le ; les ; en "
'rajouter les mots en minuscule à ne pas mettre en majuscule
Public Function formatAdresse(strAdresse As Variant) As String
Dim strA As String Dim arrParticules() As String
Dim i As Long
If IsNull(strAdresse) Then Exit Function
'si c'est null on ne traite pas
If strAdresse = "" Then Exit Function
'si c'est vide on ne traite pas
arrParticules = Split(particules, ";")
strA = StrConv(strAdresse, vbProperCase)
'toutes les premieres lettres en majuscule
For i = 0 To UBound(arrParticules)
strA = Replace(strA, arrParticules(i), LCase(arrParticules(i)))
'supprime la majuscule
Next
formatAdresse = strA
End Function
On renseigne la constante avec les mots que l’on ne veut pas mettre en majuscule. 1) le strconv() met toutes les 1ère lettre de chaque mot en majuscule. 2) la boucle For remplace les mots trouvés qui correspondent à ceux de la constante.
L’appel de la fonction
Sélectionner la zone de texte de l’adresse que j’ai nommé Adresse, l’évènement Après MAJ et mettre ceci :
Private Sub Adresse_AfterUpdate()
Me.Adresse.Value = formatAdresse(Me.Adresse.Value)
End Sub
« Adresse » est le nom de la zone de texte. Elle doit être remplacée par le nom de celle que vous souhaitez traiter.
