Ouvrir sous Excel les tables de ACESS

Trier par date Trier par votes
A

Ashaar

XLDnaute Junior
Re : Ouvrir sous Excel les tables de ACESS

Bonjour,

J'ai crée il y a longtemps un code XL qui liste toutes les tables/champs et requetes d'un projet sous Access et place le résultat dans une nouvelle feuil XL.

Je le mets tel quel, j'ai juste supprimé les ajouts de coloriage pour rendre le résultat plus joli.
Je viens d'essayer, ça fonctionne toujours.

A adapter bien sur.

Sub Requete()

Dim bdd As Database, req As QueryDef, enr As Recordset
Dim snameV As String
Dim cmpcodeV As String
Dim codeV As String

Sheets.Add
Range("A1") = "REQUETES"
Range("B1") = "TABLES"

Range("A1").Select

On Error GoTo erreurs
Set bdd = Workspaces(0).OpenDatabase("C:\MaBaseAccess.mdb")
On Error GoTo 0

'affiche les tables présentes dans la base de données ainsi que leur champs
aaa = bdd.TableDefs.Count
xya = 2
For bb = 0 To aaa - 1
ccc = bdd.TableDefs(bb).Name
Cells(xya, 2).Value = ccc
Cells(xya, 2).Font.Italic = True
Cells(xya, 2).Font.Underline = xlUnderlineStyleSingle
Cells(xya, 2).Font.Bold = True
Cells(xya, 2).Font.ColorIndex = 3
xya = xya + 1

'Nombre de Champs dans la table
bbb = bdd.TableDefs(bb).Fields.Count
For cc = 0 To bbb - 1

'Récupération des champs de la table
fff = bdd.TableDefs(bb).Fields(cc).Name
Cells(xya, 2).Value = fff
xya = xya + 1
Next
Next

'affiche les requètes présentes dans la base de données ainsi que leur champs
aaa = bdd.QueryDefs.Count
xya = 2
For bb = 0 To aaa - 1
ccc = bdd.QueryDefs(bb).Name
Cells(xya, 1).Value = ccc
Cells(xya, 1).Font.Italic = True
Cells(xya, 1).Font.Underline = xlUnderlineStyleSingle
Cells(xya, 1).Font.Bold = True
Cells(xya, 1).Font.ColorIndex = 3
xya = xya + 1
bbb = bdd.QueryDefs(bb).Fields.Count
For cc = 0 To bbb - 1
fff = bdd.QueryDefs(bb).Fields(cc).Name
Cells(xya, 1).Value = fff
xya = xya + 1
Next
Next

bdd.Close

end sub
 
Vote positif 0 Vote négatif
A

Ashaar

XLDnaute Junior
Re : Ouvrir sous Excel les tables de ACESS

En fait, j'avais mal lu votre demande, la rq que j'avais publié permet de récupérer le nom des Tables et l'intitulé des champs ainsi que les requêtes.

Le code suivant liste les tables existantes et affiche les données présentes dans les champs :

On se place donc sur Excel et...

1) Sur ma cession EXCEL, les références suivantes sont activées dans l'interface VB

'Visual Basic for application
'Microsoft Excel 11.0 Object Library
'Microsoft forms 2.0 Object Library
'Microsoft DAO 3.6 Object Libray

2) le Code à placer dans un module sous EXCEL

Sub Requete()
Dim bdd As Database, req As QueryDef, enr As Recordset
Dim snameV As String
Dim cmpcodeV As String
Dim codeV As String

chemin = Range("A11")
fich = Range("A12")
Sheets.Add
Range("A1").Select

Set bdd = Workspaces(0).OpenDatabase("C:\TABLE.mdb")
On Error Resume Next

'affiche les tables présentes dans la base de données ainsi que leur champs
aaa = bdd.TableDefs.Count
xya = 2
For bb = 0 To aaa - 1
ccc = bdd.TableDefs(bb).Name
Cells(xya, 1).Value = ccc

'Nombre de Champs dans la table
bbb = bdd.TableDefs(bb).Fields.Count

For cc = 0 To bbb - 1
'Récupération des champs de la table
fff = bdd.TableDefs(bb).Fields(cc).Name
Cells(xya + 1, cc + 1).Value = fff
Next

Sql = "SELECT * FROM " & ccc & ";"
Set enr = bdd.OpenRecordset(Sql)
numberOfRows = Cells(xya + 2, 1).CopyFromRecordset(enr)
enr.Close

Selection.End(xlDown).Select
xya = ActiveCell().Row + 1
Next

bdd.Close
End Sub
 
Vote positif 0 Vote négatif
A

Ashaar

XLDnaute Junior
Re : Ouvrir sous Excel les tables de ACESS

Bonjour,

Bon, j'ai un peu modifié le code pour afficher une table par feuille.
Dans la foulée, j'ai ajouté une instruction pour ne pas faire apparaître les tables systeme.
Puis j'ai aussi modifié le nom des variables pour qu'elles soient plus lisible et je les ai déclaré (C'est plus propre)

Sub Requete()
Dim bdd As Database, req As QueryDef, enr As Recordset

Dim NbTBL As Long 'Nombre de tables
Dim NbFLD As Long 'Nombre de champs
Dim NumTBL As Long 'N° de la Table en cours
Dim TBLNom As String 'Nom de la table
Dim SQL As String 'Code Sql
Dim FLD As Variant 'Tableau des données
Dim NumFLD As Long 'N° du champ en cours

On Error Resume Next
Set bdd = Workspaces(0).OpenDatabase("C:\TABLE.mdb")

'affiche les tables présentes dans la base de données ainsi que leur champs
NbTBL = bdd.TableDefs.Count

For NumTBL = 0 To NbTBL - 1

TBLNom = bdd.TableDefs(NumTBL).Name

'Permet de ne pas prendre en compte les tables system
If bdd.TableDefs(NumTBL).Attributes <> 0 Then GoTo OnPasse

Sheets.Add
Range("A1").Select
Cells(1, 1).Value = TBLNom
ActiveSheet.Name = TBLNom

'Nombre de Champs dans la table
NbFLD = bdd.TableDefs(NumTBL).Fields.Count

'Récupération des champs de la table
For NumFLD = 0 To NbFLD - 1
FLD = bdd.TableDefs(NumTBL).Fields(NumFLD).Name
Cells(2, NumFLD + 1).Value = FLD
Next

'Extraction des données
SQL = "SELECT * FROM " & TBLNom & ";"
Set enr = bdd.OpenRecordset(SQL)
numberOfRows = Cells(3, 1).CopyFromRecordset(enr)
enr.Close

OnPasse:
Next NumTBL

bdd.Close
End Sub
 
Vote positif 0 Vote négatif
A

Ashaar

XLDnaute Junior
Re : Ouvrir sous Excel les tables de ACESS

La derniere petite question n'est pas simple à mettre en oeuvre :

Il faut analyser le résultat renvoyé par la requete SQL et pour chaque ligne, recopier chaque champ dans XL.

En gros ca revient à dire :
1) Va à la 1ere ligne puis copie la valeur de la 1ere colonne dans Xl, puis la valeur de la 2eme colonne, puis... jusqu'a la derniere colonne.

2) Va à la ligne suivante et fais la meme chose qu'au point 1

3) etc.. jusqu'a la ligne 65000 (env)

4) Après la ligne 65000, cree une nouvelle feuille et continue à copier.


Je ne promets rien mais je vais essayer.
 
Vote positif 0 Vote négatif
A

Ashaar

XLDnaute Junior
Re : Ouvrir sous Excel les tables de ACESS

Bon, à titre d'information, pour une table de 410 000 lignes et 9 colonnes, le traitement à pris env 10 mn.

Vous trouverez ci-dessous le code qui permet de scinder une table de plus de 65000 lignes en plusieures feuilles Excel (avec renommage de l'onglet) :

NOTA : J'ai fait ça rapidement et n'ai pas pris le temps de modifier les déclarations de variables. Mais j'ai quand même commenté mon code.

Sub Requete()
Dim bdd As Database, req As QueryDef, enr As Recordset

Dim NbTBL As Long 'Nombre de tables
Dim NbFLD As Long 'Nombre de champs
Dim NumTBL As Long 'N° de la Table en cours
Dim TBLNom As String 'Nom de la table
Dim SQL As String 'Code Sql
Dim FLD As Variant 'Tableau des données
Dim NumFLD As Long 'N° du champ en cours

Application.ScreenUpdating = False

On Error Resume Next
Set bdd = Workspaces(0).OpenDatabase("C:\TABLE.mdb")

'affiche les tables présentes dans la base de données ainsi que leur champs
NbTBL = bdd.TableDefs.Count

'Fais pour chaque table
For NumTBL = 0 To NbTBL - 1

TBLNom = bdd.TableDefs(NumTBL).Name

'Permet de ne pas prendre en compte les tables system
If bdd.TableDefs(NumTBL).Attributes <> 0 Then GoTo onpasse

Sheets.Add 'Ajoute une feuille
Range("A1").Select
Cells(1, 1).Value = TBLNom 'saisi le nom de la table
ActiveSheet.Name = TBLNom 'Renome l'onglet

'Nombre de Champs dans la table
NbFLD = bdd.TableDefs(NumTBL).Fields.Count

'Récupération des champs de la table
For NumFLD = 0 To NbFLD - 1
FLD = bdd.TableDefs(NumTBL).Fields(NumFLD).Name
Cells(2, NumFLD + 1).Value = FLD
Next

'Extraction des données
SQL = "SELECT * FROM " & TBLNom & ";"
Set enr = bdd.OpenRecordset(SQL)

'Analyse des données
With enr
.MoveLast
.MoveFirst 'Se place au 1er enregistrement

cptL = 3 'Compteur de ligne
feuille = 0 'Compteur pour l'incrémentation du nom de la feuille

For xx = 0 To enr.RecordCount 'Pour le nombre total de lignes
If cptL <= 65000 Then 'Tant que nous ne sommes pas à la ligne 65000

For yy = 0 To NbFLD - 1
msg = bdd.TableDefs(NumTBL).Fields(yy).Name
Cells(cptL, yy + 1).Value = enr.Fields(msg).Value
Next yy

cptL = cptL + 1

Else 'Si on dépasse la ligne 65000
Sheets.Add
feuille = feuille + 1
ActiveSheet.Name = TBLNom & "_" & feuille 'renomme la feuille
Rows("1:1") = Sheets(TBLNom).Rows("2:2").Value 'recopie les titres
cptL = 2
For yy = 0 To NbFLD - 1 'rempli les cellules
msg = bdd.TableDefs(NumTBL).Fields(yy).Name
Cells(cptL, yy + 1).Value = enr.Fields(msg).Value
Next yy
cptL = cptL + 1

End If

.MoveNext 'Passe à l'enregistrement suivant
Next xx

End With

enr.Close 'Ferme la table en cours
onpasse:
Next NumTBL 'Passe à la Table suivante

bdd.Close 'Ferme le fichier Access
MsgBox ("Fin du traitement")
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
Autres Exporter *facilement* des tables Excel vers SQL SSMS SQL Server Management Studio ?
Réponses
1
Affichages
174
dysorthographie
dysorthographie
J
  • Résolu(e)
Power BI Import fichier excel 2021avec requêtes power query dans Power Bi
Réponses
1
Affichages
204
jozerebel
J
M
  • Question
XL 2010 Lancer requête création de table depuis Excel
Réponses
5
Affichages
355
Hasco
Hasco
Usine à gaz
  • Question
Autres Windoxs 10 : Exécuter tous mes classeurs Excel et PDF en tant qu'administrateur
2
Réponses
17
Affichages
650
Usine à gaz
Usine à gaz
C
  • Résolu(e)
XL 2021 Paramètres de "Range" en VBA
2 3
Réponses
40
Affichages
736
Constantin
C
oguruma
POWERQUERY :: Combiner les onglets d'un classeur Excel ou certains au cas par cas
Réponses
0
Affichages
140
oguruma
oguruma
S
  • Question
XL 2019 Ventiler les données dans différentes tables, mapping, MCD.
Réponses
1
Affichages
170
gbinforme
G
Usine à gaz
  • Résolu(e)
Autres Ouverture de mes classeurs Excel
Réponses
2
Affichages
259
Usine à gaz
Usine à gaz
S
  • Question
Access Gestion de stock
Réponses
0
Affichages
423
Schwalby
S
luke3300
  • Question
Power BI MFC de colonne suivant valeurs de 2 tables différentes
Réponses
0
Affichages
357
luke3300
luke3300

Membres actuellement en ligne

2 membres et 24 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
312 338
Messages
2 087 397
Membres
103 536
dernier inscrit
komivi