MS ACCESS : Classe et gain de temps

Le concept de classe en VBA a certes des lacunes mais il ne doit pas être négligés pour autant.

En effet par leur utilisation ont peut gagner un temps précieux. Voici un petit exemple fonctionnel d’une classe qui gère les évènements DblClick et NotInList d’une zone de liste déroulante. Le DblClick permet d’ouvrir un formulaire de saisie/édition avec l’item de la liste, tandis que NotInList permet de saisir l’item.

Créer le module de classe

Dans VBE faites Insertion/Module de classe. En bas à gauche dans la fenêtre des propriétés vous devez renseigner le nom de l’instance. cComboBox

classe1

Instancing permet de définir si la classe n’est visible que dans le fichier courant ou si elle est visible depuis l’extérieur. Laissez 1 – Private.

Déclaration

Sur la ligne qui suit les options, nous allons déclarer les variables nécessaires. Tout d’abord la plus importante, celle qui contiendra l’objet Combobox.

Private WithEvents LmCombo          As Access.ComboBox

WithEvents indique que cet objet pourra lever des évènements.

Access.ComboBox est le type Liste déroulante.

Ensuite nous aurons besoin de variables de type String pour stocker différents éléments nécessaires à l’ouverture du formulaire.

'nom du formulaire qui est appelé lors du notinlist
Private strFormNameLie     As String       
   'nom du champ id de la table recevant la nouvelle valeur
Private strIdFieldName     As String       
   'nom du champ recevant la valeur saisie dans la combo 
Private strControlName     As String       
   'nom de la table recevant la nouvelle valeur
Private strTableFormLie    As String

En suivant nous écrivons deux méthodes habituelles dans les classes.

Private Sub Class_Initialize()
' Initialise

End Sub

La Class_Initialize est exécutée au démarrage de la classe. Elle ne contient rien dans cet exemple.

Private Sub Class_Terminate()
' libère les variables
    On Error Resume Next
    Set LmCombo = Nothing
End Sub

Tandis que Class_Terminate est exécuté lorsqu’on libère la classe, qu’on la décharge. Celle-ci est importante car c’est là qu’on décharge également toutes nos variables.

Pour charger la combo depuis le formulaire il faut utiliser un Setteur. Le voici !

Public Property Set objComboBox(objCombo As Access.ComboBox)
    Set LmCombo = objCombo
    LmCombo.OnDblClick = "[Event Procedure]"
    LmCombo.OnNotInList = "[Event Procedure]"
End Property

On voit qu’on lui passe un objet combobox et qu’il est chargé dans la variable définie précédemment. Les 2 lignes suivantes permettent d’activer l’écoute des évènements dont nous avons besoin : DblClick et NotInList.

Les autres variables ou propriétés de la classe doivent également être valorisées toujours à l’aide de Setteurs.

Public Property Let frmNameLie(strNomFormulaireLie As String)
    strFormNameLie = strNomFormulaireLie
End Property
Public Property Let idFieldName(strNomIdFieldFormulaireLie As String)
    strIdFieldName = strNomIdFieldFormulaireLie
End Property
Public Property Let controlNameLie(strNomControleFormulaireLie As String)
    strControlName = strNomControleFormulaireLie
End Property




Public Property Let tableNameLie(strNomTableFormulaireLie As String)
    strTableFormLie = strNomTableFormulaireLie
End Property

Rien de bien particulier à part qu’on utilise un Let au lieu du Set réservé aux objets.

Nos variables sont devenus des propriétés de la classe.

Méthode privée

Une méthode privée permettra d’attendre la fermeture du formulaire de saisie avant de poursuivre l’exécution du code. Nous d’obtiendrons un déroulement synchrone du processus.

Private Sub pAttendreFermeture(vlFrmRprt As Object)
      '-----------------------------------------------------------
      ' Procedure   : pAttendreFermeture
      ' Author      : Fabrice CONSTANS
      ' Date        : 20/10/2011
      ' Description : Attend la fermeture de l'objet pour rendre la main
      ' Paramètres  : vlFr est l'objet à controler
      '-----------------------------------------------------------
        On Error GoTo pgAttenteFermeture_Error
        Do
            DoEvents
        Loop While vlFrmRprt.Visible

pgAttenteFermeture_Error:
        On Error GoTo 0
        Exit Sub
End Sub

Les évènements

Les évènements vont être gérés à l’aide de procédure qui deviendront de fait des méthodes de la classe. La différence c’est qu’à aucun moment nous ne devront les appeler pour qu’elles fonctionnent. Ceci grâce au WithEvents de la déclaration et à l’activation des écouteurs.

Le Notinlist

On remarque que la signature de la procédure est strictement identique à celle qui pourrait être générée dans un formulaire. Je vous conseille d’ailleurs d’utiliser des signature générée et de les copier dans la classe.

Public Sub LmCombo_NotInList(NewData As String, Response As Integer)
'--------------------------------------------------------------------
' Procedure : LmContact_NotInList
' Author    : Fabrice CONSTANS (MVP)
' Date      : 21/01/2016
' Purpose   : Nouveau contact, on appelle le formulaire de saisie.
'------------------------------------------------------------------
'
Dim strNouveauNumero As String

On Error GoTo Errsub

    If vbYes = MsgBox("Cette valeur n'existe pas. " & _
           "Souhaitez-vous la créer ?", vbInformation + vbYesNo, _
                                      "classe ccombo") Then
      'ouverture du formulaire en mode Ajout  
      DoCmd.OpenForm strFormNameLie, acNormal, , , acFormAdd
      'on gèle le contrôle reception de la valeur saisie
      Forms(strFormNameLie).Controls(strControlName).Enabled = False
      'on ajoute la valeur saisie dans la liste
      Forms(strFormNameLie).Controls(strControlName).Value = NewData
      'traitement synchrone
      pAttendreFermeture Forms(strFormNameLie)

'Vérification que le valeur existe (peut-être que l'utilisateur a
' changé d'avis et a annulé la création
   If dLookUp("nz(" & strIdFieldName & ",-1)" _
, strTableFormLie, strControlName & "=""" & NewData & """") > 0 Then
         'la valeur a été saisi
         Response = acDataErrAdded
      Else
        'la valeur n'a pas été saisi (annulation)  
        Response = acDataErrContinue
        LmCombo.Parent.Undo
     End If
   Else
     'il ne souhaite pas la création
     Response = acDataErrContinue
     LmCombo.Parent.Undo
   End If

Exitsub:
      On Error GoTo 0
      Exit Sub
Errsub:
       msgbox "cComboBox.LmCombo_NotInList", Err, Erl, Err.Description
End Sub

Vous pouvez constater que nous utilisons bien les constantes habituelles pour ce type d’évènement : NewData, acDataErrContinue, acDataErrAdded

Le DblClick

Cet évènement est plus simple que le précédent puisqu’il ne fait qu’ouvrir le formulaire en mode consultation/modification.
A la sortie on pense à rafraichir le contenu de la combo au cas ou l’utilisateur a modifié une valeur.
Il va de soit que pour cette dernière le traitement doit également être synchrone.

Public Sub LmCombo_DblClick(Cancel As Integer)
'------------------------------------------------------------------
' Procedure : btnEditContact_Click
' Author    : Fabrice CONSTANS (MVP)
' Date      : 16/02/2016
' Purpose   : edit et raffraichit la liste au retour
'------------------------------------------------------------------
'
Dim Id As Long

On Error GoTo Errsub

    If IsNull(LmCombo.Column(0)) Then
        MsgBox "Pour créer un item vous devez entrer sa valeur.", _
               vbInformation + vbOKOnly, "classe ccombo"
        Exit Sub
    End If

    Id = LmCombo.Column(0)

    DoCmd.OpenForm strFormNameLie, acNormal, , _
                strIdFieldName & "=" & Id, acFormEdit

    pAttendreFermeture Forms(strFormNameLie)
    LmCombo.Undo
    LmCombo.Requery
    LmCombo.value = Id

 Exitsub:
   On Error GoTo 0
   Exit Sub 

Errsub:
    msgbox ("cComboBox.LmCombo_DblClick", Err, Erl, Err.Description)
End Sub

Voilà la Classe cCombo est prête à être utilisée. Voyons cela dans les faits.

Utiliser la classe dans un formulaire

En premier lieu il faut indiquer au formulaire que nous allons utiliser cette classe. Pour cela nous devons utiliser autant de variables qu’il y a de zone de liste à implémenter. Ces variables doivent être globale, donc déclarer immédiatement après les 2 lignes d’Options du module de classe du formulaire.

Dim cComboClient         As cComboBox

Dans l’événement Sur Ouverture du formulaire on poursuit la déclaration.





Set cComboClient = New cComboBox

cComboClient.controlNameLie = "RaisonSociale"
cComboClient.frmNameLie = "fClient"
cComboClient.idFieldName = "id_Client"
Set cComboClient.objComboBox = Me.Controls("lmClient")
cComboClient.tableNameLie = "tClient"

New permet de créer l’instance de la classe et ainsi pouvoir valoriser les propriétés.

Dans cet exemple la liste déroulante se nomme lmClient. Vous pouvez adapter ce code déclaratif à votre propre cas. Vous ne devez jamais modifier la classe pour y intégrer des noms propres à l’application. Une classe doit rester générique sous peine de ne plus être portable.

Il va de soit qu’à chaque nouvelle liste déroulante à instancier, un code similaire devra être ajouté.

Une fois sauvegardé, vous pouvez utiliser le formulaire.

Les tests de comportement à faire :

  • Entrer une nouvelle valeur.
  • Double cliquer sur la zone de liste.

Classe en VBA, quels avantages ?

Le poids de l’application : On remplace des centaines de lignes par une partie déclarative.

L’uniformité du comportement : Comme on utilise le même code pour tous les contrôles nous sommes sûr que le comportement sera la même.

Maintenance et évolution : Si un bug est constaté ou que l’on souhaite faire évoluer le comportement, une seule intervention est nécessaire. Le recopie de code ne sont plus nécessaires avec leur lots d’erreurs potentielles.

Rapidité de conception : Une simple déclaration permet d’exploiter la classe.

Le revers de la médaille : En cas d’erreur non traitée, il peut se produire un déchargement des classes. Il faudra alors exécuter les déclarations une nouvelle fois.

La mise au point peut s’avérer plus complexe qu’avec un code standard, c’est pour cela qu’il est conseillé lorsqu’on débute, de concevoir les traitements dans un formulaire pour ensuite le transformer en classe.

Conclusion

J’espère que ce tuto vous aura plu et qu’il vous donnera des idées d’implémentations pour vos développements.

La recherche et les accents en SQL et VBA.

Rechercher dans une base de données avec l’opérateur Like est assez trivial. Avec quelques jokers on arrive à retrouver ce que l’on souhaite. Cependant lorsque on a affaire à des contenus ayant des caractères accentués il est difficile de récupérer à la fois ceux qui en comporte et ceux qui n’en ont pas.

L’objet de ce billet est d’utiliser VBA pour contourner ce problème.

La première chose à faire est de créer une fonction qui va traiter le mot recherché.

Function ConvertAccForLike(strValue As String) As String
' Fabrice Constans (MVP ACCESS) mars 2016
If InStr(1, strValue, "a") > 0 Then
    strValue = Replace(strValue, "a", "[aàâä]")
End If
If InStr(1, strValue, "e") > 0 Then
    strValue = Replace(strValue, "e", "[eéèêë]")
End If
If InStr(1, strValue, "i") > 0 Then
    strValue = Replace(strValue, "i", "[iîï]")
End If
If InStr(1, strValue, "o") > 0 Then
    strValue = Replace(strValue, "o", "[oôö]")
End If
If InStr(1, strValue, "u") > 0 Then
    strValue = Replace(strValue, "u", "[uùûü]")
End If
ConvertAccForLike = strValue
End Function

Dans cette fonction, on recherche la présence des voyelles, une à une, en commençant par le a, ensuite le e, puis le i, etc. Chaque fois que la voyelle est détectée on la remplace par la syntaxe Contient de l’opérateur Like, soit […]

Pour le mot « eleve », la valeur renvoyée sera :

"[eéèêë]l[eéèêë]v[eéèêë]"

Les mots trouvés seront :

eleve, éleve, élève, élevé…

Vous pouvez l’utiliser directement dans objet requête, une source de formulaire, une clause Where d’un OpenForm ou OpenReport comme dans une requête en VBA.

Voici son utilisation :

SELECT * FROM matable WHERE champ1 Like convertAccForLike("eleve");

Evidemment vous pouvez compléter avec les autres jokers.

SELECT * FROM matable WHERE champ1 Like convertAccForLike("eleve?");

Bonne utilisation !

Champ mémo et Export Excel, la galère !?

Si vous avez un jour tenté de lier un source de données MS Access, requête ou table, à Excel, vous avez sûrement été confronté à l’interprétation aléatoire des champs mémo.

Aléatoire ? Pas tant que ça. Il faut savoir que pour réaliser un export à partir du menu DONNEES EXTERNES / Exporter Excel, MS Access ne se base non pas sur la structure du champ mais sur le contenu des premières lignes. Si dans ces premières lignes il rencontre un contenu de plus de 255 caractères il considère ce champ comme mémo (texte long)… et là tout va bien.

Dans le cas contraire, il tronquera tout le reste à 255 caractères qui est la limite du format Texte Court, anciennement Texte. Adieu vos 32 000 caractères suivant !

Info : Un champ Texte Long, anciennement  Mémo, de la base de données 
Jet (Ms ACCESS) et d'une capacité de 65 535 caractères exactement.
Une cellule MS EXCEL en contient tout au plus 32 767.
Il en manquera toujours un peu.

On peut donc oublier l’export CSV ou depuis la commande MS Access, à part faire un tri sur le nombre de caractères de votre champ mémo, si techniquement cela ne pose aucun problème fonctionnellement cela peut ne pas convenir. On ne sera jamais sûr d’avoir la totalité du contenu.

Heureusement, il existe un méthode, certes un peu plus complexe mais également plus efficace. Il s’agit de l’automation. Autrement dit, piloter Excel depuis Access. Il existe une méthode de copie de recordset disponible avec VBA Excel.

CopyFromRecordset

Cette méthode est disponible dans Excel sans ajout de bibliothèque (Références) car il faut le savoir, Excel est un consommateur de Recordset à ses heures.

Voici le code commenté :

Function fInsertInSheet(ByVal strPath As String, 
                        ByVal strFeuille As String, 
                        rst As Recordset2) As Boolean
      '-----------------------------------------------------------------
      ' Procedure : fInsertInSheet
      ' Author    : Fabrice CONSTANS (MVP)
      ' Date      : 21/01/2014
      ' Purpose   : Insère un ou plusieurs enregistrements issu de RST
      '             dans la feuille excel strFeuille du fichier strPath
      '             utilise fFieldFormated() et ADODB
      ' Parameters: strPath = chemin+nom du fichier Xls au format 12.0
      '             strFeuille = la feuille dans laquelle insérer l'enrg
      '             rst = le recordset contenant les données à insérer
      ' Return    : Boolean renvoi vrai si insertion réussie
      '-----------------------------------------------------------------
      '
      'Ecrit le recordset transmis dans la feuille indiquée
          Dim strSql As String
          Dim i As Long
          Dim l As Long
          ' Late Binding (cf mon article)
          Dim oExcel As Object         ' Excel application
          Dim oFeuille As Object       ' la feuille
          Dim oWork As Object          ' le workbook
          Dim boolStateDisplayAlerts As Boolean
          Dim boolStateAskToUpdateLinks As Boolean
          On Error GoTo Errsub
          
          Set oExcel = CreateObject("Excel.Application")
          oExcel.Visible = False
          'enregistre l'état
          boolStateDisplayAlerts = oExcel.DisplayAlerts
          boolStateAskToUpdateLinks = oExcel.AskToUpdateLinks
          'met en mode silentieux
          oExcel.AskToUpdateLinks = False
          oExcel.DisplayAlerts = False
          
          Set oWork = oExcel.Workbooks.Open(strPath) 
          ' ouvre le classeur
          
          Set oFeuille = oWork.Sheets(strFeuille)    
          ' active la feuille
          
          'xlByRows, xlPrevious
          l = 1                     'insertion en ligne 1
          oFeuille.Cells(l, 1).CopyFromRecordset rst 
          'copie recordset
          
          oExcel.Windows(1).Visible = True      
          oWork.Save                            
          'on le sauve

          'remet à l'état d'origine
          oExcel.DisplayAlerts = boolStateDisplayAlerts
          oExcel.AskToUpdateLinks = boolStateAskToUpdateLinks
          
          oExcel.Visible = True
          oExcel.Quit
          
          Set oFeuille = Nothing ' ferme les objet xls
          Set oWork = Nothing
          Set oExcel = Nothing
          fInsertInSheet = True  'ça c'est bien passé !
Exitsub:
         On Error GoTo 0
         Exit Function
              
Errsub:
          fInsertInSheet = False  'il y a un problème

          'ici une gestion d'erreur ou un msg

End Function

Donc voilà un code pas si mystérieux. On ouvre un recordset coté Access et on le copie coté Excel.

ACCESS – Répéter des données dans un état

La répétition de données dans un état peut être une nécessité, c’est souvent le cas pour l’édition d’étiquettes, de formulaires en plusieurs exemplaires ou tout simplement pour des codes barres.

Plusieurs solutions

La première, qui fait plus office de bricolage consiste à dupliquer les enregistrements à la source. Cependant cela nécessite d’avoir une table source dévouée à l’impression, de préparer l’impression en amont et bien sûr de consacrer du temps SGBD et serveur pour cette tâche.

La seconde, celle que nous allons mettre en pratique consiste à utiliser le moteur d’impression des états d’ACCESS pour simuler cette duplication.

Comment procéder ?

Admettons une table composé des 2 colonnes suivantes :

  • ValeurAImprimer qui contient les données à imprimer. (Texte 255)
  • FréquenceImpression un code qui détermine la fréquence d’impression. (Texte 50)

On commence par créer un état simplement basé sur cette table, on cache la zone de texte FréquenceImpression en mettant sa propriété Visible à Non.

Voilà le décors est planté, il n’y a plus qu’à insérer le code VBA correspondant.

Le code

Le code exploite les évènements Sur Ouverture et Sur Formatage, une variable globale, une petite fonction qui peut être facultative comme nous le verrons plus tard et utilise la propriété NextRecord propre aux états ACCESS.

La variable globale va permettre de compter les occurrences imprimées.

Option Compare Database
Option Explicit
Dim cpt As Long

Lors de l’ouverture de l’état la variable est initialisée à 1.

Private Sub Report_Open(Cancel As Integer)
    cpt = 1
End Sub

A chaque préparation de l’impression de la zone détail on analyse ce qui doit être effectué.

Private Sub Détail_Format(Cancel As Integer, FormatCount As Integer)
cpt = cpt + 1 
If cpt <= nbrRepeat(Me.FréquenceImpression) Then 
    Me.NextRecord = False 
Else
    cpt = 1 End If
End Sub

Si le compteur (cpt) n’a pas atteint le nombre de répétition souhaité on réimprime le même enregistrement.
Ce tour de force est effectué grâce à la propriété NextRecord qui, si elle est False, ne charge pas l’enregistrement suivant.

Le nombre de répétition est déterminé par la valeur contenue dans FréquenceImpression.
Dans cet exemple on veut imprimer suivant une périodicité une quantité déterminée d’informations.

Function nbrRepeat(period As String)
Select Case period
    Case "trimestriel"
       nbrRepeat = 3
    Case "annuel"
       nbrRepeat = 1
    Case "semestriel"
       nbrRepeat = 2
End Select
End Function

Par exemple si FréquenceImpression contient « trimestriel » l’enregistrement sera imprimé 3 fois.

Notez que cette dernière fonction peut être paramétrée à votre guise, ne pas exister du tout si vous indiquez directement le nombre dans la colonne FréquenceImpression ou si le nombre d’impression est fixe.

Bonne impression !

ACCESS : se positionner sur l’item d’une liste déroulante en entrant une partie du texte.

Dernièrement, un internaute me demandait s’il était possible de modifier le fonctionnement de l’auto complétion dans les listes déroulante. S’agissant d’une fonctionnalité interne d’ACCESS, il est évident que ce n’est pas possible nativement.

Par contre on peut toujours contourner le problème à l’aide du code VBA. Voici cette astuce basée sur l’utilisation de l’évènement KeyPress (touche pressée) de la liste.

On commence par créer une variable globale dans le formulaire pour stocker les touches pressées.

Option Compare Database
Option Explicit
Dim strList As String   'stocke les keycode

A chaque touche tapée par l’utilisateur, on parcourt la liste à la recherche du premier item correspondant aux caractères saisis.

Private Sub Modifiable1_KeyPress(KeyAscii As Integer)
Dim i As Long
'contrôle les touches
If KeyAscii = 27 Then strList = ""  'Sur Echap vide le contenu
If Not (KeyAscii > 64 And KeyAscii < 123) Then Exit Sub  
'ce n'est pas un caractère A-Z a-z (à affiner)

strList = strList & Chr(KeyAscii)  'ajoute la touche pressée

For i = 0 To Me.Modifiable1.ListCount - 1  'parcours les items
    If Me.Modifiable1.Column(1, i) Like "*" & strList & "*" Then  
       'l'item correspond

       'pour un liste
       'Me.Modifiable1.ListIndex = i  'on s'y positionne

       'pour une liste déroulante
       Me.Modifiable1 = Me.Modifiable1.Column(0, i)

       Exit For  'et on sort
    End If
Next
End Sub

La méthode suivante donne la valeur de la colonne 2 de la ligne i.

Column(1, i)

Likz est un opérateur logique commun à SQL et VBA.

Like "*" & strList & "*"

Par sécurité on vide les caractères saisis sur la prise et la perte du focus.

Private Sub Modifiable1_GotFocus()
strList = "" 'perte du focus on vide la liste de touche
End Sub
Private Sub Modifiable1_LostFocus()
     strList = ""   'perte du focus on vide les keycode
End Sub

Comme vous le voyez, rien de complexe, on utilise juste les nombreuses possibilités d’Access pour contourner le problème. Il va sans dire que l’auto complétion classique de la liste fonctionne toujours.

N’hésitez pas à affiner le contrôle des touches tapées, en effet, dans cet exemple seul l’alphabet classique est pris en compte, il manque les caractères accentués, les chiffres…

VBA : Arguments multiples pour un même paramètre par l’exemple

Certaines syntaxes permettent de passer plusieurs arguments dans le paramètre. C’est le cas de la commande MsgBox par exemple, où le paramètre Buttons accepte plusieurs valeurs de l’énumérateur vbMsgBoxStyle.

Il est assez simple d’utiliser cette technique dans vos propres commandes ou fonctions. Voici comment procéder :

L’énumérateur

Commencez par créer un module standard pour accueillir la fonction. Dans l’en-tête, après la ligne Option Explicit, nous allons définir l’énumérateur. L’énumérateur est une simple structure de données de variable.





Option Compare Database
Option Explicit

Public Enum efFichierExt
    Unite = 8
    Chemin = 16
    Fichier = 32
    Extension = 64
End Enum

Pour en savoir plus sur l’énumération en VBA, son potentiel et ses bienfaits dans votre code, consultez mon tutoriel : http://loufab.developpez.com/tutoriels/access/enumVBA/

Il est très important que les valeurs de l’enum soit en base 8, comme vous le verrez par la suite.

La fonction

L’écriture de la fonction est assez triviale. La signature de la fonction fait référence à l’enum comme un type classique.

Public Function fFichierExt(strCheminFichier As String, _
                            iType As efFichierExt) As String

'-----------------------------------------------------------------

Le paramètre iType est donc de type efFichierExt, notre enum.

Maintenant, pour tester la présence des différentes valeurs dans iType, il ne faut pas utiliser les opérateurs logiques (=, <>…) habituels mais AND.

Voici comme on procède :

If iType And Unite Then      ' l'unité
   vRetour = Left(strCheminFichier, InStr(strCheminFichier, ":"))
End If

iType And Unite est l’équivalent de « Est-ce que iType contient Unite ? »

Voici la fonction complète qui permet d’extraire de parties du chemin d’un fichier.





Public Function fFichierExt(strCheminFichier As String, _
                iType As efFichierExt) As String
'--------------------------------------------------------------
' Procedure : fFichierExt
' Author    : Fabrice CONSTANS (MVP) blogaccess.free.fr
' Date      : 13/03/2013
' Purpose   : Retourne l'un des éléments suivant le chemin/fichier '               passé
' Parametres:
' strCheminFichier contient le chemin et fichier
' strType = enum eTypeFichierExt
'    64   renvoi l'extension du fichier sans le point
'    32   renvoi le nom du fichier sans son extension
'    16   renvoi le chemin sans le nom ni l'extension
'    8    renvoi l'unité
'--------------------------------------------------------------
   On Error GoTo Errsub

   Dim vRetour As String
   If iType And Unite Then      ' l'unité
        
     vRetour = Left(strCheminFichier, InStr(strCheminFichier, ":"))

   End If
   If iType And Chemin Then     ' le chemin

      vRetour = vRetour & Mid(strCheminFichier, 3, _
                  InStrRev(strCheminFichier, "\") - 2)

   End If
   If iType And Fichier Then

      Dim tmpFic As String

      If strCheminFichier Like "*.*" Then

         tmpFic = Right(strCheminFichier, _
         Len(strCheminFichier) - InStrRev(strCheminFichier, "\"))
         vRetour = vRetour & Left(tmpFic, InStrRev(tmpFic, ".") - 1)
      Else
         vRetour = strCheminFichier
      End If

  End If

    
  If iType And Extension Then   ' renvoi l'extension
     If iType And Fichier Then vRetour = vRetour & "."
        vRetour = vRetour & Right(strCheminFichier, _
           Len(strCheminFichier) - InStrRev(strCheminFichier, "."))
  End If
  fFichierExt = vRetour
  Exit Function

Errsub:
   
'ici utiliser votre propre traitement d'erreur
Exit Function

End Function

Comme vous le voyez, iType est analysé plusieurs fois. A chaque analyse on concatène ou non l’élément souhaité.

La première analyse détermine si l’on doit renvoyer l’unité, la deuxième le chemin etc.

L’appel se fait de la manière suivante :

? fFichierExt("c:\windows\temp\monfichier.tmp", Fichier + Extension)

On remarque que, comme pour MsgBox, les paramètres multiples sont additionnés.

Dans cet exemple le résultat sera :

monfichier.tmp

On peut donc renvoyer tout ou partie de la valeur passée. Par exemple :

? fFichierExt("c:\windows\temp\monfichier.tmp", Unite + Chemin + _
                    Fichier + Extension)

Evidemment, vous pouvez faire l’addition dans l’ordre que vous souhaitez, le résultat sera toujours le même.

? fFichierExt("c:\windows\temp\monfichier.tmp", Extension + Fichier)

Conclusion

L’utilisation d’un enum en base 8 et de l’opérateur logique AND permet de passer autant de paramètres que l’on souhaite. Encore faut-il en avoir l’utilité…

Vous pouvez utiliser la fonction ci-dessus dans vos applications dans la mesure où vous ne modifiez pas le nom de l’auteur.

Erreur 3061 : Trop peu de paramètres 1 requis

Ce message est assez commun lorsque vous manipulez des requêtes dans VBA. Nous allons voir pourquoi cela s’affiche et quelles sont les solutions à y apporter. Dans l’exemple suivant tout est correct , aucune erreur n’est déclenchée.

Sub getName()
Dim db As dao.Database
Dim rst As dao.Recordset

Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT [Nom] FROM " & _
          "tCONTACT WHERE Nom='Martin';", dbOpenSnapshot)

MsgBox "son nom est " & rst.Fields("Nom").Value

rst.Close
Set rst = Nothing
Set db = Nothing

End Sub

Lorsqu’on utilise cette requête avec un paramètre issue d’un formulaire comme ci-dessous :

Sub getName()

...
Set rst = db.OpenRecordset("SELECT [Nom] FROM " & _
          "tCONTACT WHERE Nom=forms.fChercher.txt_nom;", dbOpenSnapshot)

MsgBox "son nom est " & rst.Fields("Nom").Value
...

End Sub

Voici le message Erreur 3061 Trop peu de paramètres… qui apparaît :

Erreur 3061 Trop peu de paramètres. 1 attendu.
Erreur 3061 Trop peu de paramètres. 1 attendu.

La seule solution à ce problème est que les paramètres de provenant de l’IHM, du Form, soient interprétés non plus par le moteur de base de données comme avec ce code mais directement par VBA.

1ère Solution :

La partie IHM est directement interprétée par VBA qui n’envoie que la valeur au moteur de base de données.

Set rst = db.OpenRecordset("SELECT [Nom] FROM tCONTACT " & _

          "WHERE Nom=""" & Forms.fChercher.txt_nom & """;", dbOpenSnapshot)

C’est ceci qui est envoyé au moteur de base de données :

SELECT [Nom] FROM tCONTACT WHERE Nom="Martin";

2ème Solution :

Set rst = db.OpenRecordset("SELECT [Nom] FROM tCONTACT " & _

          "WHERE Nom=Eval('Forms.fChercher.txt_nom');", dbOpenSnapshot)

Ici c’est un peu différent, c’est la fonction VBA Eval() qui fait la liaison entre le moteur de base de données et l’interface (formulaire). Eval() résout l’expression Forms et renvoi sa valeur.

3ème Solution :

Celle-ci est un peu plus complexe car elle nécessite l’écriture d’une fonction utilisateur.

Set rst = db.OpenRecordset("SELECT [Nom] FROM tCONTACT " & _
           "WHERE Nom=fDonneNom();", dbOpenSnapshot)

Dans un module standard écrivez cette fonction :

Public Function fDonneNom() As Variant
    fDonneNom = Forms.fChercher.txt_nom
End Function

Ce cas est plutôt à envisager lorsque la valeur renvoyée est le résultat d’une opération complexe comme un calcul, une concaténation…

Public Function fDonneNom() As String
    fDonneNom = Forms.fChercher.txt_nom
End Function

4ème Solution :

Cette solution est à envisager surtout si vous avez de nombreux paramètres issus de l’IHM ou qu’ils sont hétérogènes ; issus de plusieurs sources (VBA, résultat de requête, IHM…).

Commencez par modifier la requête en utilisant la clause PARAMETERS. Vous pouvez utiliser le QBE (Query By Exemple), autrement dit l’éditeur de requêtes de Microsoft Access, en Mode Création pour créer cette clause et l’alimenter.

Le menu Parameters.
Le menu Parameters.

Remplissez le tableau qui apparaît avec un paramètre par ligne et réglez son type (texte, date, entier…). Une fois ceci effectué placez vos paramètres sur la ligne de critères.

Si vous basculer en mode SQL, voici ce que vous pourrez observer :

PARAMETERS [txt_nom] Text ( 255 ), [NumSociete] Long;

SELECT tContact.Nom, tContact.Prenom, tContact.IdSociete 
FROM tContact

WHERE (((tContact.Nom) Like [txt_nom]) 
AND ((tContact.IdSociete)=[NumSociete]));

 La clause PARAMETERS et ses arguments sont terminés par un point-virgule. Coté VBA voici comment utiliser les PARAMETERS de cette requête.

Sub getName()

Dim db As DAO.Database
Dim qry As DAO.QueryDef
Dim rst As DAO.Recordset
Dim sql As String

Set db = CurrentDb

'composition de la requete SQL
sql = "PARAMETERS [txt_nom] Text ( 255 ), [NumSociete] Long; "
sql = sql & " SELECT tContact.Nom, tContact.Prenom, " 
sql = sql & "        tContact.IdSociete"
sql = sql & " FROM tContact"
sql = sql & " WHERE tContact.Nom Like [txt_nom] "
sql = sql & "     AND tContact.IdSociete=[NumSociete];"

'creation de la requete
Set qry = db.CreateQueryDef("rqtemporaire", sql)

'affectation des valeurs aux parametres
qry.Parameters("txt_nom") = Forms.FChercher.txt_nom
qry.Parameters("NumSociete") = Forms.FChercher.numSociete

'composition du recordset
Set rst = qry.OpenRecordset(dbOpenSnapshot)

'Resultat
MsgBox "Il s'apelle " & rst.Fields("Nom").Value

rst.Close
qry.Close

Set qry = Nothing
Set rst = Nothing
Set db = Nothing

End Sub

Comme vous le voyez il faut passer par un objet Query pour accéder aux Parameters, puis faire un recordset à partir de ce dernier. C’est plus complexe mais lorsque vous avez de nombreuses valeurs à passer à la requête vous gagnez du temps.

Early ou Late Binding : Qu’est-ce que c’est ? Comment choisir ?

Si vous utilisez des bibliothèques externes à MS Access, comprenez qui ne sont pas distribuées avec 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.

Exemple de références d'une application MS ACCESS.
Exemple de références d’une application MS ACCESS.

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.

Option Compare Database
Option Explicit

Const wdDoNotSaveChanges = 0
Const wdExportFormatPDF = 17

Les objets sont typés de manière générique.

'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.

Sans la bibliothèque.
Sans la bibliothèque.

Voici un cas concret d’une vérification de présence de Word lors de l’ouverture d’un formulaire.

Private Sub Form_Open(Cancel As Integer)
On Error GoTo ErrSub 

Dim wApp As Object
Set wApp = CreateObject("Word.Application")
Set wApp = Nothing
Exit Sub

ErrSub:
If Err.Number = 429 Then
   MsgBox "Vous devez disposer de Word pour utiliser cette fonctionnalité."
   vComposant = False 
End If

End Sub

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.

MS ACCESS et persistance (1)

Nous sommes conscient que la séparation des données de l’ihm est primordiale pour une application MS Access. L’attachement automatique est depuis de nombreuses années rentré dans les mœurs, chaque développeur utilise le sien.

Si au moment de l’installation, il est obligatoire de spécifier le chemin du fichier de données, lors des mises à jour de l’application cela peut agacer l’utilisateur. Surtout si elles sont régulières. On se doit alors d’utiliser la persistance pour sauvegarder ces paramètres.

Comment créer de la persistance pour les paramètres d’une application ?

En fait il n’y a pas une, mais plusieurs méthodes pour stocker ses valeurs de configuration. La première utilise les fichiers ini. Ce sont des fichiers texte qui ont une structure particulière dont voici un exemple :

[Etiquette1]
parametre1=Valeur
parametre2=Valeur

[Etiquette2]
parametre1=Valeur

Lire et écrire dans un fichier ini

Lire et écrire dans ce type de fichier ne constitue pas une grosse difficulté puisque Windows possède ces 2 fonctions dans l’API Kernel32.

Je vous livre ici ces 2 fonctions implémentées en VBA qui permettent de gérer un fichier ini dans le répertoire de l’application.

Private Declare Function GetPrivateProfileString Lib "kernel32" _
                       Alias "GetPrivateProfileStringA" _ 
           (ByVal lpApplicationName As String, _
            ByVal lpKeyName As Any, ByVal lpDefault As String, _ 
            ByVal lpReturnedString As String, _
            ByVal nSize As Long, _
            ByVal lpFileName As String) As Long

Private Declare Function WritePrivateProfileString Lib _
            "kernel32" Alias "WritePrivateProfileStringA" _ 
           (ByVal lpApplicationName As String, _
            ByVal lpKeyName As Any, ByVal lpString As Any, _ 
            ByVal lpFileName As String) As Long

Const vgInifile = "monapplication.ini"

Function pIniLireParametre(vlEntete As String, _
                           vlNomParametre As String) As String
'----------------------------------------------------------------
' Procedure    : pIniLireParametre
' Description  : renvoi un paramètre depuis un fichier ini 
'                spécifié par vgIniFile
' Parameters   : vlNomParametre est le nom du paramètre à renvoyer
' Return       : le paramètre correspondant à vlNomParametre
'----------------------------------------------------------------
On Error GoTo Errsub
Dim vParam As String, vlLong As Long
vParam = String(255, 0)

vlLong = GetPrivateProfileString(vlEntete, vlNomParametre, _
          "", vParam, 255, CurrentProject.Path & "\" & vgInifile)

If vlLong <> 0 Then vParam = Left$(vParam, vlLong)

pIniLireParametre = RTrim(vParam)

Exit Function

Errsub:
pIniLireParametre = ""

End Function

Function pIniEcrireParametre(vlEntete As String, _
        vlNomParametre As String, _
        vlValeurParametre As String) As Boolean

'--------------------------------------------------------------
' Procedure    : pIniEcrireParametre
' Description  : remplace le paramètre dans un fichier ini spécifié
' Parameters   : vlEntete est l'entête de la rubrique []
'                vlNomParametre est le nom du paramètre
'                vlValeurParametre est la valeur du paramètre
' Return       : N/A
'--------------------------------------------------------------
'
On Error GoTo Errsub
pIniEcrireParametre = True

WritePrivateProfileString vlEntete, vlNomParametre, vlValeurParametre, _
                          CurrentProject.Path & "\" & vgInifile
Exit Function

Errsub:
pIniEcrireParametre = False

End Function

Mise en œuvre de la persistance

Admettons un fichier Ini comportant plusieurs paramètres dont celui indiquant le répertoire du fichier de données.

[Donnees]
CheminData=C:\Users\fabrice\ApplicationData\data.accdb

La lecture se fera via l’instruction suivante :

vFichierData = pIniLireParametre("Donnees", "CheminData")

Il sera alors très simple de vérifier le chemin fourni et celui des tables attachées.

Pour écrire le paramètre on utilise cette instruction lors de la première installation :

pIniEcrireParametre "Donnees", "CheminData", _
        "c:\Users\fabrice\ApplicationData\data.accdb"

Conclusion

En quelques commandes vous avez donné de la persistance à votre application et apporter un sérieux gain de confort à l’utilisateur.