Tatiak

Excel, Vba, Vbs


25 mai 2016

Utiliser une base de données Access depuis un fichier Excel

Sous Excel, il est parfois utile d'interagir avec des fichiers Access, par exemple si vous disposez d'une version d'Office sans Access mais que vous avez besoin d'expoiter des données au format .mdb ou .accdb

La solution passe par ADO (ActiveX Data Objects) et des requêtes Sql (cf. http://sql.sh/).
A noter, le Vba n'accepte pas tout le langage Sql standard, mais pour l'essentiel on y arrive.

La méthode se base sur une fonction "passe-partout" qui établit la connection avec le fichier externe et qui exécute une requête Sql quelconque (en lecture ou écriture). La fonction renvoie un entier long correspondant soit à -1 si problème, soit 0 pour des requêtes INSERT ou DELETE qui ont abouti, soit au nombre d'enregistrements lus pour des requêtes SELECT. Dans ce dernier cas les enregistrements sont stockés dans la variable tableau "Rcd".
Voici son code à mettre dans un module quelconque :

Function Query(Req As String, Optional Head As Byte = 1) As Long
Dim Cnx As Object, Rst As Object
Dim T As Variant, Col_SQL As Integer, i As Long, j As Long

    On Error GoTo errhdlr
    Set Cnx = CreateObject("ADODB.Connection")
    Cnx.Provider = "MSDASQL"
    
    Cnx.Open "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)}; DBQ=" & BDD
 
    If Left(Req, 6) = "SELECT" Then
        Set Rst = CreateObject("ADODB.Recordset")
        Rst.Open Req, Cnx, 3

        Col_SQL = Rst.Fields.Count - 1
        If Head = 1 Then
            ReDim Rcd(Col_SQL, 0)
            For i = 0 To Col_SQL
                Rcd(i, 0) = Rst.Fields(i).Name
            Next i
        End If
        
        Query = Rst.RecordCount
        If Not Query = 0 Then
            If Head = 1 Then ReDim Preserve Rcd(Col_SQL, Query) _
            Else ReDim Rcd(Col_SQL, Query - 1)
            ReDim T(Col_SQL, Query - 1)
            Rst.MoveFirst
            T = Rst.GetRows
            For i = 0 To UBound(T, 1)
                For j = 0 To UBound(T, 2)
                    Rcd(i, j + Head) = IIf(IsNull(T(i, j)), "", T(i, j))
                Next j
            Next i
        End If
    Else
        Cnx.Execute Req
        Query = 0
    End If
    
    Cnx.Close
    Set Rst = Nothing
    Set Cnx = Nothing
    Exit Function
    
errhdlr:
    If Not Rst Is Nothing Then If Rst.State = 1 Then Rst.Close
    If Not Cnx Is Nothing Then If Cnx.State = 1 Then Cnx.Close
    Set Rst = Nothing
    Set Cnx = Nothing
    Query = -1
    MsgBox (Err.Description)
End Function

     
Pour commencer, il sera nécessaire d'initialiser la variable BDD, par exemple dès l'ouverture du fichier Excel :

Private Sub Workbook_Open()
    BDD = ActiveWorkbook.Path & "\BaseAccess.accdb"
    ' ou bien : BDD = "C:\dossier_truc\sous-dossier_bidule\BaseAccess.accdb"
End Sub


Voici ensuite 3 procédures de base (à placer par exemple dans le même module que la fonction précédente), pour inserer, mettre à jour ou supprimer un enregistrement d'une base "BDD":

Sub Insert_DB(Tbl As String, Head As String, Data As String)

    Req = "INSERT INTO [" & Tbl & "]"
    If Not Head = "" Then Req = Req & " (" & Head & ")"
    Req = Req & " VALUES (" & Data & ")"
    lig = Sql.Query(Req)
End Sub


Sub Update_DB(Tbl As String, UPD As String, Cond As String)

    Req = "UPDATE [" & Tbl & "] SET " & UPD & " WHERE " & Cond
    lig = Sql.Query(Req)
End Sub


Sub Delete_DB(Tbl As String, Cond As String)

    Req = "DELETE FROM [" & Tbl & "]  WHERE " & Cond
    lig = Sql.Query(Req)
End Sub



Ainsi, pour créer par exemple la 100ème ligne dans la table "CLIENTS", il suffira d'écrire : (ici la table contient 3 champs : Id, Nom, Prenom)

    Insert_DB "CLIENTS", "Id, Nom, Prenom", "100, 'Dupond', 'Jean'"

Vous aurez remarqué : les données textes sont entourées par des quotes simples contrairement aux données numériques.

Pour des dates, elles seront au format mm/jj/aaaa et entourées par des dièses, ex pour le 24 mai 2016 : #05/20/2016#


Pour mettre à jour cette 100ème ligne, on écrira un truc genre:

    Update_DB "CLIENTS", "Nom='DuponT', Prenom='Marc'", "Id=100"
     

Pour supprimer cette 100ème ligne, il suffira d'écrire :

    Delete_DB "CLIENTS", "Id=100"
     

Mais comment savoir que l'enregistrement suivant à créer sera le 100ème?
Et bien il suffit d'interroger la base avant l'Insert via une nouvelle fonction :

Function Get_Max_Id(Tbl As String, Head As String) As Long

    Req = "SELECT MAX(" & Head & ") FROM [" & Tbl & "]"
    Get_Max_Id = Query(Req)
    If Rcd(0, 1) = "" Then Get_Max_Id = 0 Else Get_Max_Id = CLng(Rcd(0, 1))
End Function

Le numéro du prochain enregistrement s'obtient alors facilement  :

    Dim Id_suivant as Long
    Id_suivant = Get_Max_Id("CLIENTS", "Id") + 1


On peut donc interroger la base par des SELECT. Un exemple simple et utile, pour alimenter une liste déroulante à partir d'un champs d'une table, une fonction de base :

Function Get_Combo(Tbl As String, Chps As String) As Variant()

    Req = "SELECT DISTINCT " & Chps & " FROM [" & Tbl & "]" & _
            " ORDER BY " & Chps

    If Query(Req, 0) > 0 Then Get_Combo = Application.Transpose(Rcd) _
    Else Get_Combo = Array("")
End Function

Pour alimenter un combobox (qui sera donc sans doublon et en ordre alfa  : cf DISTINCT et ORDER BY), avec ici la liste des noms des clients, on écrira simplement :

    Userform1.ComboBox1.List = Get_Combo("Clients", "Nom")


Pour finir, un exemple de fonction tirée d'une de mes appli, pour montrer que la requête Sql peut inclure des jointures et des champs calculés (on peut aussi faire des agrégations):

    Function Get_EvnParRsc(id As Long, dt1 As Date, dt2 As Date, Gen As String, Cat As String) As Variant()
                           
        Req = "SELECT E.Genre, E.Categ, E.Deb, E.Fin, E.Hfin-E.Hdeb, R.Nom " & _
                " FROM ([Evnmnts] AS E" & _
                " INNER JOIN [Assoc] AS A ON A.Id_Ev=E.Id)" & _
                " INNER JOIN [Ressources] AS R ON R.Id=A.Id_Re" & _
                " WHERE R.Id=" & id & _
                " AND ((clng(E.Deb) BETWEEN " & CLng(dt1) & " AND " & CLng(dt2) & " )" & _
                " OR (clng(E.Fin)  BETWEEN " & CLng(dt1) & " AND " & CLng(dt2) & ")" & _
                " OR (clng(E.Deb)<" & CLng(dt1) & " AND clng(E.Fin)>" & CLng(dt2) & "))"

        If Not Gen = "" Then Req = Req & " AND E.Genre='" & Gen & "'"
        If Not Cat = "" Then Req = Req & " AND E.Categ='" & Cat & "'"
       
        Req = Req & " ORDER BY E.Genre ASC, E.Categ ASC"

        If Query(Req) > 0 Then Get_EvnParRsc = Application.Transpose(Rcd) _
        Else Get_EvnParRsc = Array("")
       
    End Function

Un appel à une fonction de ce genre renvoie un tableau à 2 dimensions qu'on utilise ensuite comme n'importe quel tableau ordinaire.


Pour illustrer mon propos, ci-après une démo constituée de 2 fichiers (à décompresser dans un même dossier de son Pc) : un fichier Excel sans aucune donnée et un fichier accdb contenant 2 tables (et quelques données fictives) :
* une table 'Clients' (Id, Nom, Prénom)
* et une table 'Information' (Id, Id_C, Nte) => Id=le n° de la fiche info, Id_C= le n° de la fiche 'Client'

Les 2 tables sont  reliées par un index : Id <=> Id_C, relation un-à-plusieurs classique.

Le nom de la base (+ chemin) est initialisé dans le module 'Thisworkbook'

L'ensemble des fonctions de liaison avec la base Access est dans le module 'Sql'

La démo propose 2 fonctions principales :
* création d'une nouvelle fiche => bouton 'nouvelle fiche'
* consultation/modif des fiches => bouton 'Liste'

Dans la liste : un double-clic sur une ligne ouvre la fiche client pour consultation/modification

Dans la fiche : plusieurs boutons pour ajouter/supprimer une info à relier, enregistrer les modif, supprimer la fiche.
La fiche affiche l'Id, le nom, le prénom et la liste des info reliées au client (Nb : dans cette liste, pour l'affichage, des colonnes sont masquées=>largeur=0)

Le tout est fonctionnel (mais simplex), sans code 'exotique', l'objectif étant de montrer la mise en oeuvre d'une liaison Excel/Access (et non de proposer une appli d'une utilité réelle)

Téléchargement de Démo.zip

Pierre

Posté par tatiak à 18:01 - Excel-Base de Données - Commentaires [0] - Permalien [#]

Commentaires sur Utiliser une base de données Access depuis un fichier Excel

Nouveau commentaire