Bonsoir
Vous trouverez ci joint des procédures qui permettent de créer une nouvelle feuille dans un classeur fermé, par macro en utilisant le modèle ADO.
Ce n'est pas quelque chose de très habituel mais il s'agit avant tout ici de présenter les possibilités associées à Excel.
Ces procédures nécessitent d'activer la référence Microsoft ActiveX Data Objects x.x Library
Dans l'éditeur de macros:
Menu Outils
Références
Cochez la ligne "Microsoft ActiveX Data Objects x.x Library"
Cliquez sur le bouton OK pour valider
x.x dépend de la version installée sur votre poste.
Cet exemple ajoute une nouvelle feuille dans un fichier Excel fermé et y transfére le contenu d'une requête effectuée dans une table Access.
Une deuxième solution pour un résultat identique:
bonne soirée
MichelXld
Vous trouverez ci joint des procédures qui permettent de créer une nouvelle feuille dans un classeur fermé, par macro en utilisant le modèle ADO.
Ce n'est pas quelque chose de très habituel mais il s'agit avant tout ici de présenter les possibilités associées à Excel.
Ces procédures nécessitent d'activer la référence Microsoft ActiveX Data Objects x.x Library
Dans l'éditeur de macros:
Menu Outils
Références
Cochez la ligne "Microsoft ActiveX Data Objects x.x Library"
Cliquez sur le bouton OK pour valider
x.x dépend de la version installée sur votre poste.
Cet exemple ajoute une nouvelle feuille dans un fichier Excel fermé et y transfére le contenu d'une requête effectuée dans une table Access.
Code:
Sub tranfertTableAccess_Vers_ClasseurExcelFerme()
'Nécessite d'activer la référence Microsoft ActiveX Data Objects x.x Library
'Transfére une Table Access dans un nouvel onglet d'un classeur fermé.
'
Dim ExcelCn As ADODB.Connection
Dim ExcelRst As ADODB.Recordset
Dim AccessCn As New ADODB.Connection
Dim AccessRst As New ADODB.Recordset
Dim maBase As String, maFeuille As String, listeTable As String
Dim maTable As String, NomClasseur As String
Dim j As Integer
Dim Fld As ADODB.Field
'Chemin de la base Access
maBase = "C:\Documents and Settings\mimi\dossier\dataBase.mdb"
'Nom de la table Access à transfèrer
maTable = "Table1"
'Classeur ou va être créée la nouvelle feuille
NomClasseur = "C:\leClasseurFermé.xls"
'Nom de la nouvelle feuille Excel
maFeuille = "MaNouvelleFeuille"
'Connection à la base Access
AccessCn.Open "provider=microsoft.jet.oledb.4.0; data source=" & maBase
'Requète dans la table Access
AccessRst.Open "SELECT * FROM " & maTable, AccessCn, adOpenStatic
'Connection au classeur Excel
Set ExcelCn = New ADODB.Connection
ExcelCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomClasseur & ";" & _
"Extended Properties=""Excel 8.0;HDR=NO;"""
'paramétrage des entêtes et types de données
For Each Fld In AccessRst.Fields
listeTable = listeTable & Fld.Name & " " & FieldType(Fld.Type) & ","
Next Fld
'création nouvelle Feuille Excel
listeTable = Left(listeTable, Len(listeTable) - 1)
ExcelCn.Execute "create table " & maFeuille & "(" & listeTable & ")"
Set ExcelRst = New ADODB.Recordset
ExcelRst.Open "Select * from " & maFeuille, ExcelCn, adOpenKeyset, adLockOptimistic
'transfert les données Access vers le classeur Excel
Do While Not (AccessRst.EOF)
ExcelRst.AddNew
For j = 0 To ExcelRst.Fields.Count - 1
ExcelRst.Fields(j) = AccessRst.Fields(j).Value
Next j
ExcelRst.Update
AccessRst.MoveNext
Loop
AccessRst.Close
AccessCn.Close
Set ExcelRst = Nothing
Set ExcelCn = Nothing
End Sub
Code:
Function FieldType(Valeur As Long) As String
'Spécification des types de données pour la création des champs Excel.
'Attention ! la liste est incomplète.
'
Select Case Valeur
Case 6
FieldType = "currency"
Case 7, 133, 134, 135
FieldType = "Date"
Case 14, 131
FieldType = "Decimal"
Case 5
FieldType = "Float"
Case 3, 2
FieldType = "Integer"
Case 4
FieldType = "Real"
Case 200, 202
FieldType = "Text"
Case 11
FieldType = "Boolean"
Case 203
FieldType = "Memo"
Case 16
FieldType = "Tinyint"
End Select
End Function
Une deuxième solution pour un résultat identique:
Code:
Sub tranfertTableAccess_Vers_ClasseurExcelFerme_V02()
'Nécessite d'activer la référence Microsoft ActiveX Data Objects x.x Library
'Transfére une Table Access dans un nouvel onglet d'un classeur fermé
'
Dim ExcelCn As ADODB.Connection
Dim ExcelRst As ADODB.Recordset
Dim AccessCn As New ADODB.Connection
Dim AccessRst As New ADODB.Recordset
Dim maBase As String, maFeuille As String
Dim maTable As String, NomClasseur As String
Dim nbEnr As Long
'Chemin de la base Access
maBase = "C:\Documents and Settings\mimi\dossier\dataBase.mdb"
'Nom de la table Access à transfèrer
maTable = "Table1"
'Classeur dans lequel va être créée la nouvelle feuille
NomClasseur = "C:\leClasseurFermé.xls"
'Nom de la nouvelle feuille Excel
maFeuille = "MaNouvelleFeuille2"
'Connection à la base Access
AccessCn.Open "provider=microsoft.jet.oledb.4.0; data source=" & maBase
'Requète dans la table Access
AccessRst.Open "SELECT * FROM " & maTable, AccessCn, adOpenStatic
'Connection au classeur Excel
Set ExcelCn = New ADODB.Connection
ExcelCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomClasseur & ";" & _
"Extended Properties=""Excel 8.0;HDR=NO;"""
'Transfert les données d'Access vers Excel
AccessCn.Execute "SELECT * INTO [Excel 8.0;" & _
"Database=" & NomClasseur & "].[" & maFeuille & "] FROM " & maTable, nbEnr
AccessRst.Close
AccessCn.Close
Set ExcelRst = Nothing
Set ExcelCn = Nothing
End Sub
bonne soirée
MichelXld