Exporter des données sur excel !!!!
mick1819
Messages postés
24
Date d'inscription
mercredi 21 janvier 2004
Statut
Membre
Dernière intervention
26 avril 2005
-
22 mars 2005 à 08:20
sgrant Messages postés 89 Date d'inscription mercredi 26 mai 2004 Statut Membre Dernière intervention 13 mai 2005 - 22 mars 2005 à 10:54
sgrant Messages postés 89 Date d'inscription mercredi 26 mai 2004 Statut Membre Dernière intervention 13 mai 2005 - 22 mars 2005 à 10:54
A voir également:
- Exporter des données sur excel !!!!
- Arctan sur excel ✓ - Forum C++ & C++ .NET
- Excel reporter des données sur une autre feuille vba ✓ - Forum Visual Basic
- Maudite Arctangente - Forum Visual Basic
- Comment exporter agenda google excel ✓ - Forum C# / .NET
- La conversion d'un type de données varchar en type de données datetime a créé une valeur hors limites - Forum C# / .NET
4 réponses
sgrant
Messages postés
89
Date d'inscription
mercredi 26 mai 2004
Statut
Membre
Dernière intervention
13 mai 2005
1
22 mars 2005 à 09:21
22 mars 2005 à 09:21
Bonjour,
le code ci-dessous est en vba et il exporte le resultat d'une requete (connection adodb) vers excel
'retourne le resultat de la requete sur excel
Public Sub SendExcel(Optional cmdSQL As Variant = "select top 10 * from matable")
Dim i As Integer, j As Integer
Dim CnnSql As New ADODB.Connection
Dim RstSql As New ADODB.Recordset
Dim XlsFeuil As Excel.Worksheet
On Error GoTo Err_SendExcel
Set CnnSql = CurrentProject.Connection
RstSql.Open cmdSQL, CnnSql, adOpenKeyset, adLockPessimistic
Set appexcel = New Excel.Application
Err_NewClass:
Set XlsFeuil = XlsClass.Worksheets.Add
XlsFeuil.Visible = False
i = 1
j = 1
RstSql.RecordCount + 1)
'Affiche les entetes de colonnes
If Not RstSql.EOF Then
For j = 0 To RstSql.Fields.Count - 1
XlsFeuil.Cells(i, j + 1).value = RstSql.Fields(j).Name
Next
End If
'affiche les donnees
While Not RstSql.EOF
i = i + 1
For j = 0 To RstSql.Fields.Count - 1 If RstSql.Fields(j).Type adVarChar Or RstSql.Fields(j).Type adChar Then
XlsFeuil.Cells(i, j + 1).NumberFormat = "@"
End If
XlsFeuil.Cells(i, j + 1).value = RstSql.Fields(j).value
Next
RstSql.MoveNext
Wend
'realargissement automatique des colonnes
For j = 1 To RstSql.Fields.Count - 1
XlsFeuil.Columns(j).AutoFit
Next
RstSql.Close
CnnSql.Close
XlsFeuil.Visible = True
XlsFeuil.Activate
appexcel.Visible = True
Exit_SendExcel:
Exit Sub
Err_SendExcel: If Err.Number 462 Or Err.Number 91 Then
Set XlsClass = appexcel.Workbooks.Add
Resume Err_NewClass
Else
Call MessageErr(Err.Number, "Fonction_SendExcel", Err.Description)
Resume Exit_SendExcel
End If
End Sub
j'espere t'avoir aider
sg
le code ci-dessous est en vba et il exporte le resultat d'une requete (connection adodb) vers excel
'retourne le resultat de la requete sur excel
Public Sub SendExcel(Optional cmdSQL As Variant = "select top 10 * from matable")
Dim i As Integer, j As Integer
Dim CnnSql As New ADODB.Connection
Dim RstSql As New ADODB.Recordset
Dim XlsFeuil As Excel.Worksheet
On Error GoTo Err_SendExcel
Set CnnSql = CurrentProject.Connection
RstSql.Open cmdSQL, CnnSql, adOpenKeyset, adLockPessimistic
Set appexcel = New Excel.Application
Err_NewClass:
Set XlsFeuil = XlsClass.Worksheets.Add
XlsFeuil.Visible = False
i = 1
j = 1
RstSql.RecordCount + 1)
'Affiche les entetes de colonnes
If Not RstSql.EOF Then
For j = 0 To RstSql.Fields.Count - 1
XlsFeuil.Cells(i, j + 1).value = RstSql.Fields(j).Name
Next
End If
'affiche les donnees
While Not RstSql.EOF
i = i + 1
For j = 0 To RstSql.Fields.Count - 1 If RstSql.Fields(j).Type adVarChar Or RstSql.Fields(j).Type adChar Then
XlsFeuil.Cells(i, j + 1).NumberFormat = "@"
End If
XlsFeuil.Cells(i, j + 1).value = RstSql.Fields(j).value
Next
RstSql.MoveNext
Wend
'realargissement automatique des colonnes
For j = 1 To RstSql.Fields.Count - 1
XlsFeuil.Columns(j).AutoFit
Next
RstSql.Close
CnnSql.Close
XlsFeuil.Visible = True
XlsFeuil.Activate
appexcel.Visible = True
Exit_SendExcel:
Exit Sub
Err_SendExcel: If Err.Number 462 Or Err.Number 91 Then
Set XlsClass = appexcel.Workbooks.Add
Resume Err_NewClass
Else
Call MessageErr(Err.Number, "Fonction_SendExcel", Err.Description)
Resume Exit_SendExcel
End If
End Sub
j'espere t'avoir aider
sg
mick1819
Messages postés
24
Date d'inscription
mercredi 21 janvier 2004
Statut
Membre
Dernière intervention
26 avril 2005
22 mars 2005 à 09:51
22 mars 2005 à 09:51
voila mon code actuel ...
Private Sub buGenerer_Click()
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim fld As ADODB.Field
Dim nb_type As Integer
Dim nb_trait As String
Dim cpt As Integer
Dim temp As String
Dim temp1 As String
Dim temp2 As String
Dim temp3 As String
Dim longueur As Integer
Dim nb_espace As String
Dim colonne As String
Dim colonne1 As String
Dim colonne2 As String
Dim colonne3 As String
Dim nomligne As Integer
nb_type = 0
cpt = 0
'load excel
Set ex = CreateObjet("Excel.Application")
'ouvre ton doc
ex.Workbooks.Open "C:\Documents and Settings\tsilomi1\Desktop\commande.xls"
' ouverture de la connexion
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & "C:\Documents and Settings\tsilomi1\Desktop\Toner\Toner.mdb;"
'Création du fichier
Open "C:\Documents and Settings\tsilomi1\Desktop\commande.xls" For Output As #1
'Récupération des données
rst.Open "SELECT Type, Marque, Compatibilite, Serie, Couleur FROM Toner ORDER by Marque, Compatibilite, Type", cnn, adOpenForwardOnly, adLockReadOnly
Do Until rst.EOF
For Each fld In rst.Fields
If cpt = 0 Then
nb_type = nb_type + 1
temp = fld.Value
cpt = 1
ElseIf cpt = 1 Then
temp1 = fld.Value
cpt = 2
ElseIf cpt = 2 Then
temp2 = fld.Value
cpt = 3
ElseIf cpt = 3 Then
temp3 = fld.Value
cpt = 4
Else
nb_trait = ". "
nb_espace = ", " Print #1, nb_type; nb_trait; ex.range(colonne1 & nomligne) temp; nb_espace; ex.range(colonne1 & nomligne) temp1; nb_espace; ex.range(colonne2 & nomligne) = temp2; nb_espace; ex.range(colonne3 & nomligne) = temp3; nb_espace; fld.Value
cpt = 0
nomligne = nomligne + 1
End If
Next
rst.MoveNext
Loop
'Fermeture du Recordset
rst.Close
'Fermeture du fichier word
Close #1
'Fin de l'importation du fichier word
End Sub
la partie de code ou j'ai mi ex.range(colonne & nomligne) = temp ne fonctionne pas ...
Mick
Private Sub buGenerer_Click()
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim fld As ADODB.Field
Dim nb_type As Integer
Dim nb_trait As String
Dim cpt As Integer
Dim temp As String
Dim temp1 As String
Dim temp2 As String
Dim temp3 As String
Dim longueur As Integer
Dim nb_espace As String
Dim colonne As String
Dim colonne1 As String
Dim colonne2 As String
Dim colonne3 As String
Dim nomligne As Integer
nb_type = 0
cpt = 0
'load excel
Set ex = CreateObjet("Excel.Application")
'ouvre ton doc
ex.Workbooks.Open "C:\Documents and Settings\tsilomi1\Desktop\commande.xls"
' ouverture de la connexion
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & "C:\Documents and Settings\tsilomi1\Desktop\Toner\Toner.mdb;"
'Création du fichier
Open "C:\Documents and Settings\tsilomi1\Desktop\commande.xls" For Output As #1
'Récupération des données
rst.Open "SELECT Type, Marque, Compatibilite, Serie, Couleur FROM Toner ORDER by Marque, Compatibilite, Type", cnn, adOpenForwardOnly, adLockReadOnly
Do Until rst.EOF
For Each fld In rst.Fields
If cpt = 0 Then
nb_type = nb_type + 1
temp = fld.Value
cpt = 1
ElseIf cpt = 1 Then
temp1 = fld.Value
cpt = 2
ElseIf cpt = 2 Then
temp2 = fld.Value
cpt = 3
ElseIf cpt = 3 Then
temp3 = fld.Value
cpt = 4
Else
nb_trait = ". "
nb_espace = ", " Print #1, nb_type; nb_trait; ex.range(colonne1 & nomligne) temp; nb_espace; ex.range(colonne1 & nomligne) temp1; nb_espace; ex.range(colonne2 & nomligne) = temp2; nb_espace; ex.range(colonne3 & nomligne) = temp3; nb_espace; fld.Value
cpt = 0
nomligne = nomligne + 1
End If
Next
rst.MoveNext
Loop
'Fermeture du Recordset
rst.Close
'Fermeture du fichier word
Close #1
'Fin de l'importation du fichier word
End Sub
la partie de code ou j'ai mi ex.range(colonne & nomligne) = temp ne fonctionne pas ...
Mick
mick1819
Messages postés
24
Date d'inscription
mercredi 21 janvier 2004
Statut
Membre
Dernière intervention
26 avril 2005
22 mars 2005 à 10:03
22 mars 2005 à 10:03
voila mon code actuel ...
Private Sub buGenerer_Click()
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim fld As ADODB.Field
Dim nb_type As Integer
Dim nb_trait As String
Dim cpt As Integer
Dim temp As String
Dim temp1 As String
Dim temp2 As String
Dim temp3 As String
Dim longueur As Integer
Dim nb_espace As String
Dim colonne As String
Dim colonne1 As String
Dim colonne2 As String
Dim colonne3 As String
Dim nomligne As Integer
nb_type = 0
cpt = 0
'load excel
Set ex = CreateObjet("Excel.Application")
'ouvre ton doc
ex.Workbooks.Open "C:\Documents and Settings\tsilomi1\Desktop\commande.xls"
' ouverture de la connexion
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & "C:\Documents and Settings\tsilomi1\Desktop\Toner\Toner.mdb;"
'Création du fichier
Open "C:\Documents and Settings\tsilomi1\Desktop\commande.xls" For Output As #1
'Récupération des données
rst.Open "SELECT Type, Marque, Compatibilite, Serie, Couleur FROM Toner ORDER by Marque, Compatibilite, Type", cnn, adOpenForwardOnly, adLockReadOnly
Do Until rst.EOF
For Each fld In rst.Fields
If cpt = 0 Then
nb_type = nb_type + 1
temp = fld.Value
cpt = 1
ElseIf cpt = 1 Then
temp1 = fld.Value
cpt = 2
ElseIf cpt = 2 Then
temp2 = fld.Value
cpt = 3
ElseIf cpt = 3 Then
temp3 = fld.Value
cpt = 4
Else
nb_trait = ". "
nb_espace = ", " Print #1, nb_type; nb_trait; ex.range(colonne1 & nomligne) temp; nb_espace; ex.range(colonne1 & nomligne) temp1; nb_espace; ex.range(colonne2 & nomligne) = temp2; nb_espace; ex.range(colonne3 & nomligne) = temp3; nb_espace; fld.Value
cpt = 0
nomligne = nomligne + 1
End If
Next
rst.MoveNext
Loop
'Fermeture du Recordset
rst.Close
'Fermeture du fichier word
Close #1
'Fin de l'importation du fichier word
End Sub
la partie de code ou j'ai mi ex.range(colonne & nomligne) = temp ne fonctionne pas ...
Mick
Private Sub buGenerer_Click()
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim fld As ADODB.Field
Dim nb_type As Integer
Dim nb_trait As String
Dim cpt As Integer
Dim temp As String
Dim temp1 As String
Dim temp2 As String
Dim temp3 As String
Dim longueur As Integer
Dim nb_espace As String
Dim colonne As String
Dim colonne1 As String
Dim colonne2 As String
Dim colonne3 As String
Dim nomligne As Integer
nb_type = 0
cpt = 0
'load excel
Set ex = CreateObjet("Excel.Application")
'ouvre ton doc
ex.Workbooks.Open "C:\Documents and Settings\tsilomi1\Desktop\commande.xls"
' ouverture de la connexion
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & "C:\Documents and Settings\tsilomi1\Desktop\Toner\Toner.mdb;"
'Création du fichier
Open "C:\Documents and Settings\tsilomi1\Desktop\commande.xls" For Output As #1
'Récupération des données
rst.Open "SELECT Type, Marque, Compatibilite, Serie, Couleur FROM Toner ORDER by Marque, Compatibilite, Type", cnn, adOpenForwardOnly, adLockReadOnly
Do Until rst.EOF
For Each fld In rst.Fields
If cpt = 0 Then
nb_type = nb_type + 1
temp = fld.Value
cpt = 1
ElseIf cpt = 1 Then
temp1 = fld.Value
cpt = 2
ElseIf cpt = 2 Then
temp2 = fld.Value
cpt = 3
ElseIf cpt = 3 Then
temp3 = fld.Value
cpt = 4
Else
nb_trait = ". "
nb_espace = ", " Print #1, nb_type; nb_trait; ex.range(colonne1 & nomligne) temp; nb_espace; ex.range(colonne1 & nomligne) temp1; nb_espace; ex.range(colonne2 & nomligne) = temp2; nb_espace; ex.range(colonne3 & nomligne) = temp3; nb_espace; fld.Value
cpt = 0
nomligne = nomligne + 1
End If
Next
rst.MoveNext
Loop
'Fermeture du Recordset
rst.Close
'Fermeture du fichier word
Close #1
'Fin de l'importation du fichier word
End Sub
la partie de code ou j'ai mi ex.range(colonne & nomligne) = temp ne fonctionne pas ...
Mick
sgrant
Messages postés
89
Date d'inscription
mercredi 26 mai 2004
Statut
Membre
Dernière intervention
13 mai 2005
1
22 mars 2005 à 10:54
22 mars 2005 à 10:54
si je peux t'orienter g trouvais les fonctions suivantes sur l'aide d'access
Set xl = CreateObject("Excel.Sheet")
xl.Application.Workbooks.Open "C:\Documents and Settings\tsilomi1\Desktop\commande.xls"
Set XlsFeuil = XlsClass.Worksheets(1)
et ensuite tu peux travailler avec la feuille XlsFeuil
sg