Bonjour,
3 Façons de procéder ... voir la dernière manière si ton champ dans access est un champ mémo.
Cette façon de faire avec ADO porte le total à 1823
'-------------------------------------
Sub ImporterDesDonnéesDeAccess()
'Si ta table dans Access contient un champ "OleObject"
'Il faut l'exclure de la requête...sinon ça va planter !!!
'Attention, si access possède un champ mémo
'Limitation à 1823 caractères le nombre de
'caractère importé dans Excel
'Les champs "date" de la table access vont apparaître
'dans excel sous leur forme numérique avec la méthode
'CopyFromRecordSet version 2000 et 2002. Au besoin
'prévoir quelques lignes de code pour formatage
Dim X As Integer, C As Integer
Dim Cnt As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rg As Range, Sh As Worksheet
Dim NbEnr As Long, CheminDb As String
Dim NomTable As String, NomFeuille As String
Dim Requete As String
CheminDb = "C:Mes documentsComptoir.mdb"
NomTable = "Employés"
Requete = "Select * From " & NomTable & ""
'La chaîne de connexion à une base de donnée Access
Cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminDb & ";"
'Ouverture du recordset
Rst.Open Requete, Cnt, adOpenStatic
'Si aucun enregistrement est trouvé lors de la requête
If Rst.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé." & vbCrLf & _
"Fin de l'opération.", vbInformation + vbOKOnly, "Annulation"
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
Exit Sub
End If
'Éviter le rafraîchissement de l'écran
Application.ScreenUpdating = False
'Conserve dans une variable le nom de la feuille active.
NomFeuille = ThisWorkbook.ActiveSheet.Name
'Ajoute une nouvelle feuille où seront acheminées les données
Set Sh = Worksheets.Add
'détermine la cellule supérieur gauche où
'le recordset va être copié
With Sh
Set Rg = .Range("A1")
End With
'Si tu es intéressé de récupérer directement les noms
'des champs de ton recordset, tu peux utiliser ce
'qui suit :
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
X = X + 1
Loop Until X = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
End If
Rg.CurrentRegion.Columns.AutoFit
Rg.CurrentRegion.Rows.AutoFit
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
End Sub
'-------------------------------------
Deuxième manière si tes données ont plus de 1823 caractères :
L'usage de la bibliothèque de la première procédure doit être
aussi chargé
====================================== >
Sub ImporterAccessVersExcel()
Dim C As Integer
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim MyRange As Range, Requete As String
With Worksheets("Feuil4")
Set MyRange = Range("A1")
End With
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Mes DocumentsComptoir.mdb;" & _
"Jet OLEDB:Database Password=", "admin", ""
Requete = "Select * from Employés"
rst.Open Requete, cnt, adOpenKeyset
nb = rst.RecordCount
'Copie le nom des champs dans la première ligne
Do
MyRange.Offset(, C) = rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = rst.Fields.Count
MyRange.Offset(1).Resize(nb, rst.Fields.Count) = TransposeSpecial2(rst.GetRows)
End Sub
'-------------------------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------------
====================================== >
Et la troisième méthode permet jusqu'à 32765 le maximum dans une cellule
'------------------------------------
Sub ADO_QueryTable_SansODBC()
'Testé et Fonctionnel
'Accepte un champ de type mémo d'access
'Nombre de caractères limite cellule excel : 32765
'Attention au champ de type Ole
Dim Cnn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim Qt As QueryTable, Sh As Worksheet
Dim Requete As String
Set Sh = Worksheets("Feuil1") 'à déterminer
Requete = "SELECT * FROM employés" 'à déterminer
Cnn.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Mes documentsComptoir.mdb;"
Rs.Open Requete, Cnn, adOpenDynamic
'Sh.Range("A1").CopyFromRecordset Rs
Set Qt = Sh.QueryTables.Add(Rs, Sh.Range("A1"))
Qt.Refresh False
Rs.Close: Cnn.Close: Set Rs = Nothing: Set Cnn = Nothing
Set Sh = Nothing: Set Qt = Nothing
End Sub
'------------------------------------
Salutations!
"news.free.fr" a écrit dans le message de news: 436be492$0$4343$
Bonjour
Lorsque vous exportez une base access vers EXCEL le contenu des cellules est
tronquées à 255 caratères.
savez-vous comment augmenter cette limite ?
merci d'avance
Bonjour,
3 Façons de procéder ... voir la dernière manière si ton champ dans access est un champ mémo.
Cette façon de faire avec ADO porte le total à 1823
'-------------------------------------
Sub ImporterDesDonnéesDeAccess()
'Si ta table dans Access contient un champ "OleObject"
'Il faut l'exclure de la requête...sinon ça va planter !!!
'Attention, si access possède un champ mémo
'Limitation à 1823 caractères le nombre de
'caractère importé dans Excel
'Les champs "date" de la table access vont apparaître
'dans excel sous leur forme numérique avec la méthode
'CopyFromRecordSet version 2000 et 2002. Au besoin
'prévoir quelques lignes de code pour formatage
Dim X As Integer, C As Integer
Dim Cnt As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rg As Range, Sh As Worksheet
Dim NbEnr As Long, CheminDb As String
Dim NomTable As String, NomFeuille As String
Dim Requete As String
CheminDb = "C:Mes documentsComptoir.mdb"
NomTable = "Employés"
Requete = "Select * From " & NomTable & ""
'La chaîne de connexion à une base de donnée Access
Cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminDb & ";"
'Ouverture du recordset
Rst.Open Requete, Cnt, adOpenStatic
'Si aucun enregistrement est trouvé lors de la requête
If Rst.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé." & vbCrLf & _
"Fin de l'opération.", vbInformation + vbOKOnly, "Annulation"
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
Exit Sub
End If
'Éviter le rafraîchissement de l'écran
Application.ScreenUpdating = False
'Conserve dans une variable le nom de la feuille active.
NomFeuille = ThisWorkbook.ActiveSheet.Name
'Ajoute une nouvelle feuille où seront acheminées les données
Set Sh = Worksheets.Add
'détermine la cellule supérieur gauche où
'le recordset va être copié
With Sh
Set Rg = .Range("A1")
End With
'Si tu es intéressé de récupérer directement les noms
'des champs de ton recordset, tu peux utiliser ce
'qui suit :
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
X = X + 1
Loop Until X = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
End If
Rg.CurrentRegion.Columns.AutoFit
Rg.CurrentRegion.Rows.AutoFit
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
End Sub
'-------------------------------------
Deuxième manière si tes données ont plus de 1823 caractères :
L'usage de la bibliothèque de la première procédure doit être
aussi chargé
====================================== >
Sub ImporterAccessVersExcel()
Dim C As Integer
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim MyRange As Range, Requete As String
With Worksheets("Feuil4")
Set MyRange = Range("A1")
End With
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Mes DocumentsComptoir.mdb;" & _
"Jet OLEDB:Database Password=", "admin", ""
Requete = "Select * from Employés"
rst.Open Requete, cnt, adOpenKeyset
nb = rst.RecordCount
'Copie le nom des champs dans la première ligne
Do
MyRange.Offset(, C) = rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = rst.Fields.Count
MyRange.Offset(1).Resize(nb, rst.Fields.Count) = TransposeSpecial2(rst.GetRows)
End Sub
'-------------------------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------------
====================================== >
Et la troisième méthode permet jusqu'à 32765 le maximum dans une cellule
'------------------------------------
Sub ADO_QueryTable_SansODBC()
'Testé et Fonctionnel
'Accepte un champ de type mémo d'access
'Nombre de caractères limite cellule excel : 32765
'Attention au champ de type Ole
Dim Cnn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim Qt As QueryTable, Sh As Worksheet
Dim Requete As String
Set Sh = Worksheets("Feuil1") 'à déterminer
Requete = "SELECT * FROM employés" 'à déterminer
Cnn.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Mes documentsComptoir.mdb;"
Rs.Open Requete, Cnn, adOpenDynamic
'Sh.Range("A1").CopyFromRecordset Rs
Set Qt = Sh.QueryTables.Add(Rs, Sh.Range("A1"))
Qt.Refresh False
Rs.Close: Cnn.Close: Set Rs = Nothing: Set Cnn = Nothing
Set Sh = Nothing: Set Qt = Nothing
End Sub
'------------------------------------
Salutations!
"news.free.fr" <news@rene.dessalle.freesurf.fr> a écrit dans le message de news: 436be492$0$4343$626a54ce@news.free.fr...
Bonjour
Lorsque vous exportez une base access vers EXCEL le contenu des cellules est
tronquées à 255 caratères.
savez-vous comment augmenter cette limite ?
merci d'avance
Bonjour,
3 Façons de procéder ... voir la dernière manière si ton champ dans access est un champ mémo.
Cette façon de faire avec ADO porte le total à 1823
'-------------------------------------
Sub ImporterDesDonnéesDeAccess()
'Si ta table dans Access contient un champ "OleObject"
'Il faut l'exclure de la requête...sinon ça va planter !!!
'Attention, si access possède un champ mémo
'Limitation à 1823 caractères le nombre de
'caractère importé dans Excel
'Les champs "date" de la table access vont apparaître
'dans excel sous leur forme numérique avec la méthode
'CopyFromRecordSet version 2000 et 2002. Au besoin
'prévoir quelques lignes de code pour formatage
Dim X As Integer, C As Integer
Dim Cnt As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rg As Range, Sh As Worksheet
Dim NbEnr As Long, CheminDb As String
Dim NomTable As String, NomFeuille As String
Dim Requete As String
CheminDb = "C:Mes documentsComptoir.mdb"
NomTable = "Employés"
Requete = "Select * From " & NomTable & ""
'La chaîne de connexion à une base de donnée Access
Cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminDb & ";"
'Ouverture du recordset
Rst.Open Requete, Cnt, adOpenStatic
'Si aucun enregistrement est trouvé lors de la requête
If Rst.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé." & vbCrLf & _
"Fin de l'opération.", vbInformation + vbOKOnly, "Annulation"
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
Exit Sub
End If
'Éviter le rafraîchissement de l'écran
Application.ScreenUpdating = False
'Conserve dans une variable le nom de la feuille active.
NomFeuille = ThisWorkbook.ActiveSheet.Name
'Ajoute une nouvelle feuille où seront acheminées les données
Set Sh = Worksheets.Add
'détermine la cellule supérieur gauche où
'le recordset va être copié
With Sh
Set Rg = .Range("A1")
End With
'Si tu es intéressé de récupérer directement les noms
'des champs de ton recordset, tu peux utiliser ce
'qui suit :
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
X = X + 1
Loop Until X = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
End If
Rg.CurrentRegion.Columns.AutoFit
Rg.CurrentRegion.Rows.AutoFit
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
End Sub
'-------------------------------------
Deuxième manière si tes données ont plus de 1823 caractères :
L'usage de la bibliothèque de la première procédure doit être
aussi chargé
====================================== >
Sub ImporterAccessVersExcel()
Dim C As Integer
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim MyRange As Range, Requete As String
With Worksheets("Feuil4")
Set MyRange = Range("A1")
End With
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Mes DocumentsComptoir.mdb;" & _
"Jet OLEDB:Database Password=", "admin", ""
Requete = "Select * from Employés"
rst.Open Requete, cnt, adOpenKeyset
nb = rst.RecordCount
'Copie le nom des champs dans la première ligne
Do
MyRange.Offset(, C) = rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = rst.Fields.Count
MyRange.Offset(1).Resize(nb, rst.Fields.Count) = TransposeSpecial2(rst.GetRows)
End Sub
'-------------------------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------------
====================================== >
Et la troisième méthode permet jusqu'à 32765 le maximum dans une cellule
'------------------------------------
Sub ADO_QueryTable_SansODBC()
'Testé et Fonctionnel
'Accepte un champ de type mémo d'access
'Nombre de caractères limite cellule excel : 32765
'Attention au champ de type Ole
Dim Cnn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim Qt As QueryTable, Sh As Worksheet
Dim Requete As String
Set Sh = Worksheets("Feuil1") 'à déterminer
Requete = "SELECT * FROM employés" 'à déterminer
Cnn.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Mes documentsComptoir.mdb;"
Rs.Open Requete, Cnn, adOpenDynamic
'Sh.Range("A1").CopyFromRecordset Rs
Set Qt = Sh.QueryTables.Add(Rs, Sh.Range("A1"))
Qt.Refresh False
Rs.Close: Cnn.Close: Set Rs = Nothing: Set Cnn = Nothing
Set Sh = Nothing: Set Qt = Nothing
End Sub
'------------------------------------
Salutations!
"news.free.fr" a écrit dans le message de news: 436be492$0$4343$
Bonjour
Lorsque vous exportez une base access vers EXCEL le contenu des cellules est
tronquées à 255 caratères.
savez-vous comment augmenter cette limite ?
merci d'avance
Bonjour,
3 Façons de procéder ... voir la dernière manière si ton champ dans access est un champ mémo.
Cette façon de faire avec ADO porte le total à 1823
'-------------------------------------
Sub ImporterDesDonnéesDeAccess()
'Si ta table dans Access contient un champ "OleObject"
'Il faut l'exclure de la requête...sinon ça va planter !!!
'Attention, si access possède un champ mémo
'Limitation à 1823 caractères le nombre de
'caractère importé dans Excel
'Les champs "date" de la table access vont apparaître
'dans excel sous leur forme numérique avec la méthode
'CopyFromRecordSet version 2000 et 2002. Au besoin
'prévoir quelques lignes de code pour formatage
Dim X As Integer, C As Integer
Dim Cnt As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rg As Range, Sh As Worksheet
Dim NbEnr As Long, CheminDb As String
Dim NomTable As String, NomFeuille As String
Dim Requete As String
CheminDb = "C:Mes documentsComptoir.mdb"
NomTable = "Employés"
Requete = "Select * From " & NomTable & ""
'La chaîne de connexion à une base de donnée Access
Cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminDb & ";"
'Ouverture du recordset
Rst.Open Requete, Cnt, adOpenStatic
'Si aucun enregistrement est trouvé lors de la requête
If Rst.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé." & vbCrLf & _
"Fin de l'opération.", vbInformation + vbOKOnly, "Annulation"
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
Exit Sub
End If
'Éviter le rafraîchissement de l'écran
Application.ScreenUpdating = False
'Conserve dans une variable le nom de la feuille active.
NomFeuille = ThisWorkbook.ActiveSheet.Name
'Ajoute une nouvelle feuille où seront acheminées les données
Set Sh = Worksheets.Add
'détermine la cellule supérieur gauche où
'le recordset va être copié
With Sh
Set Rg = .Range("A1")
End With
'Si tu es intéressé de récupérer directement les noms
'des champs de ton recordset, tu peux utiliser ce
'qui suit :
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
X = X + 1
Loop Until X = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
End If
Rg.CurrentRegion.Columns.AutoFit
Rg.CurrentRegion.Rows.AutoFit
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
End Sub
'-------------------------------------
Deuxième manière si tes données ont plus de 1823 caractères :
L'usage de la bibliothèque de la première procédure doit être
aussi chargé
====================================== >
Sub ImporterAccessVersExcel()
Dim C As Integer
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim MyRange As Range, Requete As String
With Worksheets("Feuil4")
Set MyRange = Range("A1")
End With
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Mes DocumentsComptoir.mdb;" & _
"Jet OLEDB:Database Password=", "admin", ""
Requete = "Select * from Employés"
rst.Open Requete, cnt, adOpenKeyset
nb = rst.RecordCount
'Copie le nom des champs dans la première ligne
Do
MyRange.Offset(, C) = rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = rst.Fields.Count
MyRange.Offset(1).Resize(nb, rst.Fields.Count) = TransposeSpecial2(rst.GetRows)
End Sub
'-------------------------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------------
====================================== >
Et la troisième méthode permet jusqu'à 32765 le maximum dans une cellule
'------------------------------------
Sub ADO_QueryTable_SansODBC()
'Testé et Fonctionnel
'Accepte un champ de type mémo d'access
'Nombre de caractères limite cellule excel : 32765
'Attention au champ de type Ole
Dim Cnn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim Qt As QueryTable, Sh As Worksheet
Dim Requete As String
Set Sh = Worksheets("Feuil1") 'à déterminer
Requete = "SELECT * FROM employés" 'à déterminer
Cnn.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Mes documentsComptoir.mdb;"
Rs.Open Requete, Cnn, adOpenDynamic
'Sh.Range("A1").CopyFromRecordset Rs
Set Qt = Sh.QueryTables.Add(Rs, Sh.Range("A1"))
Qt.Refresh False
Rs.Close: Cnn.Close: Set Rs = Nothing: Set Cnn = Nothing
Set Sh = Nothing: Set Qt = Nothing
End Sub
'------------------------------------
Salutations!
"news.free.fr" a écrit dans le message de news: 436be492$0$4343$
Bonjour
Lorsque vous exportez une base access vers EXCEL le contenu des cellules est
tronquées à 255 caratères.
savez-vous comment augmenter cette limite ?
merci d'avance
Bonjour,
3 Façons de procéder ... voir la dernière manière si ton champ dans access est un champ mémo.
Cette façon de faire avec ADO porte le total à 1823
'-------------------------------------
Sub ImporterDesDonnéesDeAccess()
'Si ta table dans Access contient un champ "OleObject"
'Il faut l'exclure de la requête...sinon ça va planter !!!
'Attention, si access possède un champ mémo
'Limitation à 1823 caractères le nombre de
'caractère importé dans Excel
'Les champs "date" de la table access vont apparaître
'dans excel sous leur forme numérique avec la méthode
'CopyFromRecordSet version 2000 et 2002. Au besoin
'prévoir quelques lignes de code pour formatage
Dim X As Integer, C As Integer
Dim Cnt As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rg As Range, Sh As Worksheet
Dim NbEnr As Long, CheminDb As String
Dim NomTable As String, NomFeuille As String
Dim Requete As String
CheminDb = "C:Mes documentsComptoir.mdb"
NomTable = "Employés"
Requete = "Select * From " & NomTable & ""
'La chaîne de connexion à une base de donnée Access
Cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminDb & ";"
'Ouverture du recordset
Rst.Open Requete, Cnt, adOpenStatic
'Si aucun enregistrement est trouvé lors de la requête
If Rst.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé." & vbCrLf & _
"Fin de l'opération.", vbInformation + vbOKOnly, "Annulation"
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
Exit Sub
End If
'Éviter le rafraîchissement de l'écran
Application.ScreenUpdating = False
'Conserve dans une variable le nom de la feuille active.
NomFeuille = ThisWorkbook.ActiveSheet.Name
'Ajoute une nouvelle feuille où seront acheminées les données
Set Sh = Worksheets.Add
'détermine la cellule supérieur gauche où
'le recordset va être copié
With Sh
Set Rg = .Range("A1")
End With
'Si tu es intéressé de récupérer directement les noms
'des champs de ton recordset, tu peux utiliser ce
'qui suit :
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
X = X + 1
Loop Until X = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
End If
Rg.CurrentRegion.Columns.AutoFit
Rg.CurrentRegion.Rows.AutoFit
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
End Sub
'-------------------------------------
Deuxième manière si tes données ont plus de 1823 caractères :
L'usage de la bibliothèque de la première procédure doit être
aussi chargé
====================================== >
Sub ImporterAccessVersExcel()
Dim C As Integer
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim MyRange As Range, Requete As String
With Worksheets("Feuil4")
Set MyRange = Range("A1")
End With
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Mes DocumentsComptoir.mdb;" & _
"Jet OLEDB:Database Password=", "admin", ""
Requete = "Select * from Employés"
rst.Open Requete, cnt, adOpenKeyset
nb = rst.RecordCount
'Copie le nom des champs dans la première ligne
Do
MyRange.Offset(, C) = rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = rst.Fields.Count
MyRange.Offset(1).Resize(nb, rst.Fields.Count) = TransposeSpecial2(rst.GetRows)
End Sub
'-------------------------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------------
====================================== >
Et la troisième méthode permet jusqu'à 32765 le maximum dans une cellule
'------------------------------------
Sub ADO_QueryTable_SansODBC()
'Testé et Fonctionnel
'Accepte un champ de type mémo d'access
'Nombre de caractères limite cellule excel : 32765
'Attention au champ de type Ole
Dim Cnn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim Qt As QueryTable, Sh As Worksheet
Dim Requete As String
Set Sh = Worksheets("Feuil1") 'à déterminer
Requete = "SELECT * FROM employés" 'à déterminer
Cnn.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Mes documentsComptoir.mdb;"
Rs.Open Requete, Cnn, adOpenDynamic
'Sh.Range("A1").CopyFromRecordset Rs
Set Qt = Sh.QueryTables.Add(Rs, Sh.Range("A1"))
Qt.Refresh False
Rs.Close: Cnn.Close: Set Rs = Nothing: Set Cnn = Nothing
Set Sh = Nothing: Set Qt = Nothing
End Sub
'------------------------------------
Salutations!
"news.free.fr" <news@rene.dessalle.freesurf.fr> a écrit dans le message de news: 436be492$0$4343$626a54ce@news.free.fr...
Bonjour
Lorsque vous exportez une base access vers EXCEL le contenu des cellules est
tronquées à 255 caratères.
savez-vous comment augmenter cette limite ?
merci d'avance
Bonjour,
3 Façons de procéder ... voir la dernière manière si ton champ dans access est un champ mémo.
Cette façon de faire avec ADO porte le total à 1823
'-------------------------------------
Sub ImporterDesDonnéesDeAccess()
'Si ta table dans Access contient un champ "OleObject"
'Il faut l'exclure de la requête...sinon ça va planter !!!
'Attention, si access possède un champ mémo
'Limitation à 1823 caractères le nombre de
'caractère importé dans Excel
'Les champs "date" de la table access vont apparaître
'dans excel sous leur forme numérique avec la méthode
'CopyFromRecordSet version 2000 et 2002. Au besoin
'prévoir quelques lignes de code pour formatage
Dim X As Integer, C As Integer
Dim Cnt As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rg As Range, Sh As Worksheet
Dim NbEnr As Long, CheminDb As String
Dim NomTable As String, NomFeuille As String
Dim Requete As String
CheminDb = "C:Mes documentsComptoir.mdb"
NomTable = "Employés"
Requete = "Select * From " & NomTable & ""
'La chaîne de connexion à une base de donnée Access
Cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminDb & ";"
'Ouverture du recordset
Rst.Open Requete, Cnt, adOpenStatic
'Si aucun enregistrement est trouvé lors de la requête
If Rst.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé." & vbCrLf & _
"Fin de l'opération.", vbInformation + vbOKOnly, "Annulation"
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
Exit Sub
End If
'Éviter le rafraîchissement de l'écran
Application.ScreenUpdating = False
'Conserve dans une variable le nom de la feuille active.
NomFeuille = ThisWorkbook.ActiveSheet.Name
'Ajoute une nouvelle feuille où seront acheminées les données
Set Sh = Worksheets.Add
'détermine la cellule supérieur gauche où
'le recordset va être copié
With Sh
Set Rg = .Range("A1")
End With
'Si tu es intéressé de récupérer directement les noms
'des champs de ton recordset, tu peux utiliser ce
'qui suit :
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
X = X + 1
Loop Until X = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
End If
Rg.CurrentRegion.Columns.AutoFit
Rg.CurrentRegion.Rows.AutoFit
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
End Sub
'-------------------------------------
Deuxième manière si tes données ont plus de 1823 caractères :
L'usage de la bibliothèque de la première procédure doit être
aussi chargé
====================================== >
Sub ImporterAccessVersExcel()
Dim C As Integer
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim MyRange As Range, Requete As String
With Worksheets("Feuil4")
Set MyRange = Range("A1")
End With
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Mes DocumentsComptoir.mdb;" & _
"Jet OLEDB:Database Password=", "admin", ""
Requete = "Select * from Employés"
rst.Open Requete, cnt, adOpenKeyset
nb = rst.RecordCount
'Copie le nom des champs dans la première ligne
Do
MyRange.Offset(, C) = rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = rst.Fields.Count
MyRange.Offset(1).Resize(nb, rst.Fields.Count) = TransposeSpecial2(rst.GetRows)
End Sub
'-------------------------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------------
====================================== >
Et la troisième méthode permet jusqu'à 32765 le maximum dans une cellule
'------------------------------------
Sub ADO_QueryTable_SansODBC()
'Testé et Fonctionnel
'Accepte un champ de type mémo d'access
'Nombre de caractères limite cellule excel : 32765
'Attention au champ de type Ole
Dim Cnn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim Qt As QueryTable, Sh As Worksheet
Dim Requete As String
Set Sh = Worksheets("Feuil1") 'à déterminer
Requete = "SELECT * FROM employés" 'à déterminer
Cnn.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Mes documentsComptoir.mdb;"
Rs.Open Requete, Cnn, adOpenDynamic
'Sh.Range("A1").CopyFromRecordset Rs
Set Qt = Sh.QueryTables.Add(Rs, Sh.Range("A1"))
Qt.Refresh False
Rs.Close: Cnn.Close: Set Rs = Nothing: Set Cnn = Nothing
Set Sh = Nothing: Set Qt = Nothing
End Sub
'------------------------------------
Salutations!
"news.free.fr" a écrit dans le message de news: 436be492$0$4343$
Bonjour
Lorsque vous exportez une base access vers EXCEL le contenu des cellules est
tronquées à 255 caratères.
savez-vous comment augmenter cette limite ?
merci d'avance