IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

FAQ Excel

FAQ ExcelConsultez toutes les FAQ

Nombre d'auteurs : 46, nombre de questions : 845, dernière mise à jour : 30 mars 2022 

 
OuvrirSommaireLes macros VBApiloter d'autres applications depuis ExcelPiloter Access

Cette procédure Excel permet de créer une nouvelle table dans une base Access existante et d'y transférer le contenu d'un fichier csv.

La macro nécessite d'activer la référence "Microsoft ActiveX Data Objects x.x Library".

Vba
Sélectionnez
Sub tranfertCSV_Vers_NouvelleTableAccess()
    'Transfére un fichier CSV vers une nouvelle table Access
    'depuis une macro Excel.
    '
    'Nécessite d'activer la référence
    '"Microsoft ActiveX Data Objects x.x Library
    '
 
    Dim AccessCn As ADODB.Connection
    Dim AccessRst As ADODB.Recordset
    Dim Csv_CN As New ADODB.Connection
    Dim Csv_Rst As New ADODB.Recordset
    Dim DossierCSV As String, NomTable As String
    Dim FichCSV As String, MaBase As String
    Dim nbEnr As Long
 
    'Répertoire du fichier CSV
    DossierCSV = "C:\Documents and Settings\mimi\dossier"
    'Nom du fichier CSV à transfèrer
    FichCSV = "LeFichierCSV.csv"
    'Chemin et nom de la base Access
    MaBase = "C:\Documents and Settings\mimi\dossier\dataBase.mdb"
    'Nom de la nouvelle Table Access
    NomTable = "MaNouvelleTable"
 
 
    'Connection au fichier CSV
    Csv_CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
        DossierCSV & ";Extended Properties='text;FMT=Delimited'"
    'Requète dans le fichier CSV
    Csv_Rst.Open "SELECT * FROM " & FichCSV, Csv_CN, _
        adOpenStatic, adLockOptimistic
 
    'Connection à la base de données Access
    Set AccessCn = New ADODB.Connection
    AccessCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                   "Data Source=" & MaBase
 
 
    Csv_CN.Execute "SELECT * INTO [" & NomTable & "] IN '" & _
        MaBase & "' From [" & FichCSV & "]", nbEnr
 
 
    AccessCn.Close
    Csv_Rst.Close
    Csv_CN.Close
    Set AccessRst = Nothing
    Set AccessCn = Nothing
    Set Csv_Rst = Nothing
    Set Csv_CN = Nothing
End Sub
Créé le 10 juin 2007  par SilkyRoad

Excel dispose d'un outil intégré pour effectuer des requêtes dans des sources de données externes.
Sans macro, vous pouvez utiliser le menu Données / Données externes / Créer une requête.
Suivez les différentes étapes et complétez les boîtes de dialogue afin de paramétrer l'extraction.

Le même résultat peut être obtenu par macro :
Cette procédure effectue une requête dans une table Access et affiche le résultat dans la cellule A1.

Vba
Sélectionnez
Dim NomBase As String
 
NomBase = "C:\Documents and Settings\mimi\dataBase.mdb"
 
With Sheets("Feuil1").QueryTables.Add(Connection:=Array("OLEDB;Provider=Microsoft.jet.OLEDB.4.0;" & _
        "Data source=" & NomBase), Destination:=Sheets("Feuil1").Range("A1"))
    .CommandText = Array("SELECT * FROM Table1 WHERE CodeClient=42000")
    .Name = "TestRequete"
    .CommandType = xlCmdTable
    .FieldNames = False
    .RowNumbers = False
    .PreserveFormatting = False
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .AdjustColumnWidth = True
    .PreserveColumnInfo = False 'format
    .Refresh BackgroundQuery:=False
End With

Faites vous aider par l'enregistreur de macro si vous ne connaissez pas la syntaxe à utiliser.

Créé le 10 juin 2007  par SilkyRoad
Vba
Sélectionnez
Sub VersionMDAC()
    Dim Cn As Object
 
    Set Cn = CreateObject("ADODB.Connection")
    MsgBox "Version MDAC : " & Cn.Version
 
    Set Cn = Nothing
End Sub
Créé le 10 juin 2007  par SilkyRoad
Vba
Sélectionnez
Sub creationNouvelleBase()
    'Nécessite d'activer la référence "Microsoft ADO Ext x.x for DLL and Security"
    Dim Cat As ADOX.Catalog
    Dim MaTableIndex As ADOX.Table
    Dim CheminBase As String, NomTable As String
 
    'Chemin et nom de la nouvelle base
    CheminBase = "C:\MaNouvelleBase.mdb"
    'Nom de la table qui va être ajoutée
    NomTable = "MaTable"
 
    Set Cat = New ADOX.Catalog
    'Création base
    Cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CheminBase
 
    Set MaTableIndex = CreateObject("ADOX.Table")
    'Définit les champs pour la nouvelle table
    With MaTableIndex
        .Name = NomTable
        With .Columns
            .Append "ChampDate", adDate, 50
            .Append "ChampNombre", adInteger, 50
            .Append "ChampTexte", adWChar, 80
        End With
    End With
 
    'Création table
    Cat.Tables.Append MaTableIndex
 
    Set Cat = Nothing
    Set MaTableIndex = Nothing
End Sub
Créé le 10 juin 2007  par SilkyRoad

Ce premier exemple utilise le modèle ADO :

Vba
Sélectionnez
Sub AjoutEnregistrementTableAccess()
    'Nécessite d'activer la référence
    '"Microsoft ActiveX Data Objects x.x Library"
 
    Dim Cn As ADODB.Connection
    Dim Fichier As String, TexteSQL As String
 
    Fichier = "C:\NomBase.mdb"
 
    Set Cn = New ADODB.Connection
    Cn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Fichier
 
    'Insertion des données dans la Table1 qui contient 3 champs :
        '1 champ date (doit être encadrée par le symbole dièse #)
        '1 champ nombre
        '1 champ texte (doit être encadré par des apostrophes ')
    TexteSQL = "INSERT INTO [Table1] VALUES (#" & _
        Date & "#, " & 12345 & ", '" & Environ("username") & "')"
    Cn.Execute TexteSQL
 
    Cn.Close
    Set Cn = Nothing
End Sub

Il est aussi possible d'utiliser la bibliothèque DAO.
Ci-joint un exemple qui ajoute un enregistrement de 6 champs dans une table Access.
Vous remarquerez que toutes les données sont encadrées par des apostrophes, quelque soit le type de champ.

Vba
Sélectionnez
Sub exportDonnées_DAO()
Dim Db As DAO.Database
Dim strSQL As String
 
Set Db = DAO.OpenDatabase("C:\dossier\dataBase.mdb", False, False)
strSQL = "INSERT INTO [Table1] VALUES('999','8','DVP','7','mimi','22/10/2007')"
 
Db.Execute strSQL
Db.Close
End Sub
Créé le 10 juin 2007  par SilkyRoad

Cet exemple utilise la bibliothèque DAO.

Vba
Sélectionnez
Sub importDonnees_DAO()
    Dim Db As DAO.Database
    Dim Rs As DAO.Recordset
    Dim strSQL As String
 
    Set Db = DAO.OpenDatabase("C:\dossier\dataBase.mdb", False, False)
    strSQL = "SELECT * FROM [Table1]"
    Set Rs = Db.OpenRecordset(strSQL, DAO.dbOpenSnapshot)
 
    Range("A1").CopyFromRecordset Rs
 
    Db.Close
End Sub
Créé le 19 février 2008  par SilkyRoad

Lien : Communication entre Access et Excel

Ce code effectue un tri croissant dans la colonne "NomChamp" de la table "LesPoints".

Vba
Sélectionnez
Sub Tri_Croissant_Champ_BaseAccess()
'Nécessite d 'activer les références :
    'Microsoft ActiveX Data Objects x.x Library
    'et
    'Microsoft ADO Ext. x.x for DDL and Security
Dim Cnn As ADODB.Connection
Dim Cat As ADOX.Catalog
Dim indexTri As ADOX.Index
Dim Rst As New ADODB.Recordset
Dim Fichier As String
 
On Error GoTo Fin
Fichier = "C:\dossier\dataBase.mdb"
 
Set Cnn = New ADODB.Connection
Cnn.Open "Provider='Microsoft.Jet.OLEDB.4.0';" & _
    "Data Source='" & Fichier & "';"
 
Set Cat = New ADOX.Catalog
Set Cat.ActiveConnection = Cnn
 
Set indexTri = New ADOX.Index
With indexTri
    .Columns.Append "NomChamp"
    'tri croissant
    .Columns("NomChamp").SortOrder = adSortAscending
    .Name = "Cible"
 
    'pour les tris décroissants, utilisez :
    '.Columns("NomChamp").SortOrder = adSortDescending
    '.Name = "Cible"
 
    '.IndexNulls = adIndexNullsAllow
End With
 
'ajout d'un index pour la table "LesPoints"
'attention : renvoie une erreur si un index existe déja.
Cat.Tables("LesPoints").Indexes.Append indexTri
 
'suppression index
'Cat.Tables("LesPoints").Indexes.Delete "Cible"
 
Fin:
Cnn.Close
Set Cat = Nothing
Set indexTri = Nothing
Set Rst = Nothing
Set Cnn = Nothing
End Sub
Créé le 5 décembre 2007  par SilkyRoad

Une première solution :

Vba
Sélectionnez
Sub listerConnectesBaseAccess_V01()
    Dim Cible As String
    Dim strLigne As String
 
    'Le fichier .ldb est créé à l'ouverture de la base et supprimé lors de la fermeture.
    'Ce fichier LDB contient le nom des utilisateurs.
    Cible = "C:\Documents and Settings\dossier\dataBase.ldb"
 
    'vérifie si le fichier existe
    If Dir(Cible) = "" Then Exit Sub
 
    Open Cible For Input As #1
        Do While Not EOF(1)
            Line Input #1, strLigne
            Debug.Print strLigne
        Loop
    Close #1
 
End Sub

Une deuxième solution :

Vba
Sélectionnez
Sub listerConnectesBaseAccess_V02()
    Dim Cnn As Object
    Dim Rst As Object
    Dim Fichier As String
 
    Const JET_SCHEMA_USERROSTER = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
 
    Fichier = "C:\Documents and Settings\dossier\dataBase.mdb"
    If Dir(Fichier) = "" Then Exit Sub
 
    Set Cnn = CreateObject("ADODB.Connection")
    Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Fichier & ";"
 
    Set Rst = CreateObject("ADODB.Recordset")
    'adSchemaProviderSpecific = -1
    Set Rst = Cnn.OpenSchema(-1, , JET_SCHEMA_USERROSTER)
 
    Debug.Print Rst.GetString
 
    Cnn.Close
    Set Rst = Nothing
    Set Cnn = Nothing
End Sub
Créé le 5 décembre 2007  par SilkyRoad

La procédure crée un nouveau classeur contenant une feuille nommée "NomFeuille". La requête effectuée dans la table Access va être enregistrée dans cette feuille.
Nécessite d'activer la référence "Microsoft ActiveX Data Objects x.x Library".

Vba
Sélectionnez
Sub Test()
    TransfertAccess_Vers_Excel "C:\SauvegardeClasseur.xls", "NomFeuille"
End Sub
 
 
Sub TransfertAccess_Vers_Excel(NomClasseur As String, maFeuille As String)
    Dim AccessCnn As ADODB.Connection
    Dim maBase As String, maTable As String
    Dim nbEnr As Long
 
    'Chemin de la base Access
    maBase = "C:\Documents and Settings\dossier\database.mdb"
    'Nom de la table Access
    maTable = "Table1"
 
    'Connection à la base Access
    Set AccessCn = New ADODB.Connection
    AccessCnn.Open "provider=microsoft.jet.oledb.4.0; data source=" & maBase
 
    'Transfert les données d'Access vers Excel
    AccessCnn.Execute "SELECT * INTO [Excel 8.0;" & _
        "Database=" & NomClasseur & "].[" & maFeuille & "] FROM " & maTable, nbEnr
 
    AccessCnn.Close
    Set AccessCnn = Nothing
End Sub

Et si vous désirez effectuer la même opération directement depuis Access :

Vba
Sélectionnez
Sub TransfertAccess_Vers_Excel()
    'Crée un nouveau classeur contenant une feuille nommée "NomFeuille".
    'La requête effectuée dans la table Access va être enregistrée dans cette feuille.
 
    Dim NomClasseur As String, maFeuille As String
    Dim maTable As String
    Dim nbEnr As Long
 
    NomClasseur = "C:\SauvegardeClasseur.xls"
    maFeuille = "NomFeuille"
    'Nom de la table Access
    maTable = "Table1"
 
    'Transfert les données d'Access vers Excel
    CurrentDb.Execute "SELECT * INTO [Excel 8.0;" & _
        "Database=" & NomClasseur & "].[" & maFeuille & "] FROM " & maTable, nbEnr
    CurrentDb.Close
End Sub
Créé le 19 février 2008  par SilkyRoad

Lorsque vous utilisez l'opérateur LIKE pour effectuer une recherche dans un champ, le caractère générique astérisque (*) permet de définir une plage de valeurs.
Par exemple, a*a permet de trouver : aa, aBa, aBBBa ...

Par contre, vous devez remplacer le symbole astérisque par le symbole pourcentage (%) quand vous utilisez MSJet4 pour vous connecter.

Créé le 19 février 2009  par SilkyRoad

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2009 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.