Ouvrir sous Excel les tables de ACESS

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

Re : Ouvrir sous Excel les tables de ACESS

Bonjour,

J'ai essayer mais cela ne fonctionne pas mais vu que je suis pas un pro, j'ai du faire une erreur

J'ai erreur de compilation en m'étant en surbrillance bdd As Dataabse

Si vous pouvez m'aider

Romuald
romuald.lecordier@advisio-services.com

Re : Ouvrir sous Excel les tables de ACESS

Bonjour,

Avez vous activé la référence : Microsoft DAO 3.6 Object Library
ou la référence DAO que vous avez.

Re : Ouvrir sous Excel les tables de ACESS

Bonjour

J'ai réussi à faire la première chose mais maintenant j'ai une erreur il mets en surbrillance RANGE "A1" avec le message erreur de compilation
sub ou fonction non défini

Merci de votre aide

Romuald
romuald.lecordier@advisio-services.com

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

Re : Ouvrir sous Excel les tables de ACESS

Bonjour Ashaar et Bonjour au Forum

La macro fonctionne correctement donc merci

Dernière petite chose, est -il possible que cette macro ouvre une feuille excel par table access

Merci pour ta réponse

Romuald
romuald.lecordier@advisio-services.com

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

Re : Ouvrir sous Excel les tables de ACESS

Bonjour Ashaar

Ta macro fonctionne très bien,

Je te remercie encore pour ton aide

Juste une dernière petite question une des tables compte 498931 Lignes comment faire pour que cette macro ouvre plusieurs feuilles pour cette même table

Car excel ne comporte que 65536 lignes

Merci

Romuald
romuald.lecordier@advisio-services.com

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.

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