XL 2013 Ajouter plusieurs tables Access dans Excel

zoidberg

zoidberg

XLDnaute Nouveau
Salut à tous, je viens à vous car on m'a pose une colle au bureau...

J'ai une base de donnes Access avec plusieurs tables dedans, j'aimerais, pour compiler ces données, les importer dans excel. Mais pour simplifier la procedure chaque jour j'aimerais le faire dans une macro ( un gros bouton importer et voila).

J'ai donc fait un enregistrement de macro et fait mon import dans Excel, tout ce passe bien, le problème est que quand je ferme mon fichier et le rouvre et relance la macro, la j'ai un bug...

Si vous avez des idées pour faire cette tache de manière rapide et propre je suis preneur

(mes connaissances Excel sont très limitées)

Merci d'avance ! :)
 
Trier par date Trier par votes
Bougla972

Bougla972

XLDnaute Occasionnel
zoidberg,

Code ci-dessous issue de l'enregistreur de macro.

VB: 
Application.DisplayAlerts = False
    'Chemin BD => 'à adapter
    ActiveSheet.Cells.Clear
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=Chemin BD" _
        , _
        ";Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet " _
        , _
        "OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=6;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global" _
        , _
        " Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=Fal" _
        , _
        "se;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;" _
        , "Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False"), Destination:= _
        Range("$A$1")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("Nom de la table") 'à adapter
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = _
        "Chemin de la source" 'à adapter
        .ListObject.DisplayName = "Nom a donner" 'à adapter
        .Refresh BackgroundQuery:=False
    End With
Application.DisplayAlerts = True

Est-ce bien ce type de code que tu as généré ? Cela marche correctement pour moi.
 
Vote positif 0 Vote négatif
zoidberg

zoidberg

XLDnaute Nouveau
VB: 
Sub import()
'
' import Macro
'

'
    Workbooks("Book1").Connections.AddFromFile _
        "C:\Users\thibaud.nicolazi\Desktop\Thibaud\Postie 2017.accdb", True, False
    ActiveWorkbook.Worksheets.Add
    [B]With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook.Connections("Postie 2017"), Destination:=Range("$A$1")).TableObject[/B]
        .RowNumbers = False
        .PreserveFormatting = True
        .RefreshStyle = 1
        .AdjustColumnWidth = True
        .ListObject.DisplayName = "Table_Data_Arbitrage"
        .Refresh
    End With
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _
        Connections("Postie 2017"), Destination:=Range("$A$1")).TableObject
        .RowNumbers = False
        .PreserveFormatting = True
        .RefreshStyle = 1
        .AdjustColumnWidth = True
        .ListObject.DisplayName = "Table_Data_Arbitrage_DBM_Printed_Matter"
        .Refresh
    End With
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _
        Connections("Postie 2017"), Destination:=Range("$A$1")).TableObject
        .RowNumbers = False
        .PreserveFormatting = True
        .RefreshStyle = 1
        .AdjustColumnWidth = True
        .ListObject.DisplayName = "Table_Data_Arbitrage_SGO"
        .Refresh
    End With
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _
        Connections("Postie 2017"), Destination:=Range("$A$1")).TableObject
        .RowNumbers = False
        .PreserveFormatting = True
        .RefreshStyle = 1
        .AdjustColumnWidth = True
        .ListObject.DisplayName = "Table_Data_Direct_Entry"
        .Refresh
    End With
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _
        Connections("Postie 2017"), Destination:=Range("$A$1")).TableObject
        .RowNumbers = False
        .PreserveFormatting = True
        .RefreshStyle = 1
        .AdjustColumnWidth = True
        .ListObject.DisplayName = "Table_Data_Parcels"
        .Refresh
    End With
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _
        Connections("Postie 2017"), Destination:=Range("$A$1")).TableObject
        .RowNumbers = False
        .PreserveFormatting = True
        .RefreshStyle = 1
        .AdjustColumnWidth = True
        .ListObject.DisplayName = "Table_Data_Press"
        .Refresh
    End With
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _
        Connections("Postie 2017"), Destination:=Range("$A$1")).TableObject
        .RowNumbers = False
        .PreserveFormatting = True
        .RefreshStyle = 1
        .AdjustColumnWidth = True
        .ListObject.DisplayName = "Table_Data_Terminal_Dues_LP"
        .Refresh
    End With
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _
        Connections("Postie 2017"), Destination:=Range("$A$1")).TableObject
        .RowNumbers = False
        .PreserveFormatting = True
        .RefreshStyle = 1
        .AdjustColumnWidth = True
        .ListObject.DisplayName = "Table_Data_Terminal_Dues_SP"
        .Refresh
    End With
End Sub


Voila le code que j'ai pour cette macro, ca fonctionne aussi... mais que une fois. En gras la ligne qui plante
 
Vote positif 0 Vote négatif
zoidberg

zoidberg

XLDnaute Nouveau
Bonjour Pierre,

Ton fichier semble fonctionner, en revanche j'ai quelques soucis.

Comment je peux faire pour sélectionner les tables Access que je veux importer ? Car actuellement, ton fichier importe toutes les tables présentes dans mon fichier Access...

Et ensuite il me met une erreur "overflow" je suppose que c'est parce que certaines des tables dans Access dépassent le nombre maximum de lignes de Excel.

Je vais également tenter d'adapter ton code Bougla.

Merci.
 
Dernière édition:
Vote positif 0 Vote négatif
zoidberg

zoidberg

XLDnaute Nouveau
Je ne sais pas si cela a une importance particulière mais ce sont des requêtes Access et non des Tables que je souhaite importer.

Dans ce fichier Access j'ai un nombre important de requêtes, je souhaite en importer seulement 8 d'entres elles, que les onglets Excel crées soient au nom de la requête importée et puisse être mis à jour sans décaler tous les onglets.
 
Vote positif 0 Vote négatif
zoidberg

zoidberg

XLDnaute Nouveau
Salut tout le monde !
J'ai finalement réussit a faire mon import depuis Access grace au code suivant :

Code: 
Private Sub Command0_Click()
strPath = "Chemin de mon fichier"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Arbitrage", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Arbitrage DBM&Printed Matter", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Arbitrage SGO", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Direct Entry", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Parcels", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Press", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Terminal Dues LP", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Terminal Dues SP", strPath

End Sub

J'ai maintenant un second soucis... j'aimerais supprimer ceraines plages de cellules sur mon classeur excel avant d'importer les donnees, j'ai donc rajouter ceci avant mon import :

Code: 
Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim i As Long
    Dim vtemp As Variant
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("Chemin de mon fichier")
Set xlSheet = x1Book.Data_Arbitrage
xlSheet.Range("A:AA").ClearContent

J'ai une erreur Run time 424 Object Required...
sur la ligne Set xlSheet = x1Book.Data_Arbitrage

Vous avez une idée de ce qui ne vas pas ?
 
Vote positif 0 Vote négatif
zoidberg

zoidberg

XLDnaute Nouveau
Salut Bougla,

j'avais malencontreusement écrit x1Book et non xlbook, j'ai corrigé mais j'ai maintenant une erreur :

Run time error '91' Object variable or With block variable not set

Voila mon code entier :
VB: 
Private Sub Command0_Click()

    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim i As Long
    Dim vtemp As Variant
  
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open("C:\Users\thibaud.nicolazi\Desktop\test.xlsm")
Set xlSheet = xlBook.test.Sheets("Data_Arbitrage")
xlWs.Range("A:AA").ClearContent
strPath = "C:\Users\thibaud.nicolazi\Desktop\test.xlsm"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Arbitrage", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Arbitrage DBM&Printed Matter", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Arbitrage SGO", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Direct Entry", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Parcels", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Press", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Terminal Dues LP", strPath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Terminal Dues SP", strPath

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
zoidberg

zoidberg

XLDnaute Nouveau
Toujours le meme message d'erreur : 91 Object variable or with block variable not set

Mon code :
VB: 
Option Compare Database

Private Sub Command0_Click()

    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim i As Long
    Dim vtemp As Variant
  
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open("C:\Users\thibaud.nicolazi\Desktop\test.xlsm")
Set xlSheet = x1Book.Sheets(".Data_Arbitrage")
xlWs.Range("A:AA").ClearContent
strPath = "C:\Users\thibaud.nicolazi\Desktop\test.xlsm"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Arbitrage", strPath
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Arbitrage DBM&Printed Matter", strPath
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Arbitrage SGO", strPath
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Direct Entry", strPath
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Parcels", strPath
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Press", strPath
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Terminal Dues LP", strPath
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Data Terminal Dues SP", strPath

End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

vgendron
  • Question
Power Query [Resolu] Importer plusieurs fichiers excel provenant de dossiers différents sur sharepoint
Réponses
6
Affichages
940
Staple1600
Staple1600
F
  • Question
XL 2021 VBA et Power Query : ecrire des requetes avec variables
2
Réponses
27
Affichages
1 K
Florent74
F
G
  • Question
XL 2016 RechercheV dans plusieurs tableaux
Réponses
2
Affichages
286
grumeau10
G
S
  • Question
XL 2010 import fichier .vcf dans excel
2
Réponses
18
Affichages
1 K
dysorthographie
dysorthographie
J
  • Question
XL 2021 excel - vbs - csv
2
Réponses
28
Affichages
1 K
jerome1980
J
N
  • Résolu(e)
XL 2019 Joindre des données de plusieurs feuilles
Réponses
4
Affichages
533
Nasseuz
N
A
  • Résolu(e)
Microsoft 365 Enregistrer copie d'un fichier avec pour nom le contenu d'une cellule excel (macro)
2
Réponses
15
Affichages
504
firecarl
F
F
  • Résolu(e)
XL 2019 Power query - Réunir le contenu de plusieurs fichiers xls dans un seul
Réponses
10
Affichages
1 K
Bernard_XLD
Bernard_XLD
T
  • Résolu(e)
Microsoft 365 pb effacement macro
Réponses
8
Affichages
371
Themax
T
C
  • Question
Autres Exporter *facilement* des tables Excel vers SQL SSMS SQL Server Management Studio ?
Réponses
1
Affichages
292
dysorthographie
dysorthographie

Membres actuellement en ligne

3 membres et 65 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 107
dernier inscrit
cdel