Exporter listview vers excel
Soyez le premier à donner votre avis sur cette source.
Snippet vu 11 135 fois - Téléchargée 43 fois
Contenu du snippet
Voici un code que j'ai modifié pour exporter une listview apres une recherche vers une feuille excel,
je sais que ca se fait pas d'utiliser une erreur pour arreter le transfert mais bon, je suis débutant...
mais j'ai un probleme, l'export se fait bien, ce sont des nombres qui sont exportés vers excel, grace à ceux-ci je fait un graphique, mais mon graphique ne prend pas en compte les valeurs rentrées grace à mon code, mais si je les retapes une à une le graphique fonctionne...
Donc je vous demande si vous pouvez jetter un oeil sur mon code pour l'ameliorer et me dire pourquoi excel ne prend pas en compte les valeurs exportés (elles sont bien ecrites mais il faut les réécrire à la main pour que le graphique les prennent en compte).
Ne criez pas si le code est fouilli, je suis débutant! ;c)
MERCI!
La form comporte les elements suivant:
-un textbox nommé txtSearch
-un timer nommé timer1
-un commandbutton nommé ExportExcel
-une listview nommé lsvResult
-un commandbutton nommé mnuQuitter
-une statusbar nommé stbInfo
MERCI ENCORE!!!
je sais que ca se fait pas d'utiliser une erreur pour arreter le transfert mais bon, je suis débutant...
mais j'ai un probleme, l'export se fait bien, ce sont des nombres qui sont exportés vers excel, grace à ceux-ci je fait un graphique, mais mon graphique ne prend pas en compte les valeurs rentrées grace à mon code, mais si je les retapes une à une le graphique fonctionne...
Donc je vous demande si vous pouvez jetter un oeil sur mon code pour l'ameliorer et me dire pourquoi excel ne prend pas en compte les valeurs exportés (elles sont bien ecrites mais il faut les réécrire à la main pour que le graphique les prennent en compte).
Ne criez pas si le code est fouilli, je suis débutant! ;c)
MERCI!
Source / Exemple :
'Option Explicit
' * Variables globales *
Dim Con As New Connection ' Connection au moteur ADO
Dim Cmd As New Command ' Commande pour le moteur ADO
Dim RS As Recordset ' Tableau resultat
Dim strQuery As String ' Chaine de requête
Dim bSelect As Boolean ' Flag de selection
Dim strKeySelect As String ' Chaine de la cle selectionner
Dim bTri As Boolean ' Tri par NOM
Private Sub Command2_Click()
End Sub
Private Sub ExportExcel_Click()
Dim i As Integer
Dim j As Integer
Dim Co As Integer
Dim It As Integer
'Chemin du fichier a modifier à chaque installation
repertoire = "C:\fichier.xls"
'Ouverture de l'application
Set appexcel = New Excel.Application
'Gestion du fichier et ouverture statique
appexcel.Workbooks.Open repertoire
'Visualisation en fond d'ecran la page excel
appexcel.Visible = True
'On remplit l'entete de la page excel
appexcel.Worksheets(1).Cells(1, 1).Value = "Date et Heure:"
appexcel.Worksheets(1).Cells(1, 2).Value = "Blanc:"
appexcel.Worksheets(1).Cells(1, 3).Value = "Ciment Blanc:"
appexcel.Worksheets(1).Cells(1, 4).Value = "Ciment Gris:"
appexcel.Worksheets(1).Cells(1, 5).Value = "Concasse:"
appexcel.Worksheets(1).Cells(1, 6).Value = "Filler:"
appexcel.Worksheets(1).Cells(1, 7).Value = "Mi Casse:"
appexcel.Worksheets(1).Cells(1, 8).Value = "Roule:"
appexcel.Worksheets(1).Cells(1, 9).Value = "Silice:"
appexcel.Worksheets(1).Cells(1, 10).Value = "Silice humide:"
appexcel.Worksheets(1).Cells(1, 11).Value = "Vasilogrit:"
On Local Error GoTo fin
Co = 0
It = 0
Do
appexcel.Worksheets(1).Cells(2 + Co, 1).Value = lsvResult.ListItems.Item(1 + It)
appexcel.Worksheets(1).Cells(2 + Co, 2).Value = lsvResult.ListItems.Item(1 + It).ListSubItems(1)
appexcel.Worksheets(1).Cells(2 + Co, 3).Value = lsvResult.ListItems.Item(1 + It).ListSubItems(2)
appexcel.Worksheets(1).Cells(2 + Co, 4).Value = lsvResult.ListItems.Item(1 + It).ListSubItems(3)
appexcel.Worksheets(1).Cells(2 + Co, 5).Value = lsvResult.ListItems.Item(1 + It).ListSubItems(4)
appexcel.Worksheets(1).Cells(2 + Co, 6).Value = lsvResult.ListItems.Item(1 + It).ListSubItems(5)
appexcel.Worksheets(1).Cells(2 + Co, 7).Value = lsvResult.ListItems.Item(1 + It).ListSubItems(6)
appexcel.Worksheets(1).Cells(2 + Co, 8).Value = lsvResult.ListItems.Item(1 + It).ListSubItems(7)
appexcel.Worksheets(1).Cells(2 + Co, 9).Value = lsvResult.ListItems.Item(1 + It).ListSubItems(8)
appexcel.Worksheets(1).Cells(2 + Co, 10).Value = lsvResult.ListItems.Item(1 + It).ListSubItems(9)
appexcel.Worksheets(1).Cells(2 + Co, 11).Value = lsvResult.ListItems.Item(1 + It).ListSubItems(11)
Co = Co + 1
It = It + 1
Loop
Exit Sub
For i = 1 To 11
appexcel.Worksheets(1).Cells(1, i).Font.Bold = True
appexcel.Worksheets(1).Cells(1, i).Font.Size = 8
appexcel.Worksheets(1).Cells(1, i).HorizontalAlignment = xlCenter
appexcel.Worksheets(1).Cells(1, i).VerticalAlignment = xlCenter
Next i
For j = 1 To 11
appexcel.Worksheets(1).Cells(2, j).HorizontalAlignment = xlCenter
Next j
fin:
End Sub
' *******************************
' * Chargement de la feuille *
' *******************************
Private Sub Form_Load()
' Definition de la chaine de connection
' c'est ici qu'il faut modifier le chemin à la base de donnée : Data Source=
Con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=CAB.mdb;Persist Security Info=False"
' Connection à la base de donnée
Con.Open
' Affectation des commandes à la connection active
Cmd.ActiveConnection = Con
' Affectation des collones list view
lsvResult.ColumnHeaders.Add 1, , "Date", 110
lsvResult.ColumnHeaders.Add 2, , "Blanc", 50
lsvResult.ColumnHeaders.Add 3, , "Ciment Blanc", 80
lsvResult.ColumnHeaders.Add 4, , "Ciment Gris", 80
lsvResult.ColumnHeaders.Add 5, , "Concasse", 60
lsvResult.ColumnHeaders.Add 6, , "Filler", 50
lsvResult.ColumnHeaders.Add 7, , "Mi Casse", 60
lsvResult.ColumnHeaders.Add 8, , "Roule", 50
lsvResult.ColumnHeaders.Add 9, , "Silice", 50
lsvResult.ColumnHeaders.Add 10, , "Silice Humide", 80
lsvResult.ColumnHeaders.Add 11, , "Vasilogrit", 60
lsvResult.ColumnHeaders.Add 11, , "N°", 0
lsvResult.View = lvwReport
' Init du trie
bTri = False
stbInfo.Panels("info").Text = "Recherche par Date"
End Sub
' *******************************
' * Dechargement de la feuille *
' *******************************
Private Sub Form_Unload(Cancel As Integer)
' Fermeture de la connection
Con.Close
End Sub
' *******************************
' * Selection d'une item *
' *******************************
Private Sub lsvResult_ItemClick(ByVal Item As MSComctlLib.ListItem)
' * variables locales *
Dim strKey As String ' chaine de la cle
' Gestionnaire d'erreur
On Local Error GoTo Err
' Info selection
'stbInfo.Panels("info").Text = "Selection : " & UCase(Trim(txtNom.Text)) & " " & UCase(Trim(txtPrenom.Text))
' test si deja selectionner
If (strKeySelect = Item.Key) Then Exit Sub
' Mémorisation de la cle
strKeySelect = Item.Key
' Sortie de la routine
Exit Sub
MyErr:
' Desaffectation de la gestion erreur
On Local Error GoTo 0
' Libération des ressources
Set RS = Nothing
Exit Sub
Err:
' Desaffectation de la gestion erreur
On Local Error GoTo 0
' Libération des ressources
Set RS = Nothing
End Sub
' ***************************
' * Procédure de quitter *
' ***************************
Private Sub mnuQuitter_Click()
Unload Me
End Sub
' ***************************************************
' * Changement du contenu de la zone de recherche *
' ***************************************************
Private Sub txtSearch_Change()
' * Variable locales *
Dim strSearch As String ' Zone texte de recherche
Dim liItem As ListItem ' Variable pour l'affichage du résultat
Dim Cpt As Integer ' Compteur affichage
' Lecture de la valeur saisie
strSearch = Trim(txtSearch.Text)
strSearch = UCase(strSearch)
' Efface la zone résultat
ExportExcel.Enabled = False
lsvResult.ListItems.Clear
bSelect = False
' Test de la cohérence de la saisie
If (txtSearch.Text = "") Then Exit Sub
' Définition de la requête
If (Not bTri) Then
strQuery = "SELECT * from Ajout WHERE Date LIKE '$' ORDER BY Date ASC"
End If
' Remplace les etoiles par %
strSearch = Replace(strSearch, "*", "%", 1, , vbTextCompare)
' Test si existence d'un %
If (InStr(1, strSearch, "%", vbTextCompare) = 0) Then
strSearch = strSearch & "%"
End If
' Construction de la requête
strQuery = Replace(strQuery, "$", strSearch, 1, , vbTextCompare)
' Préparation de la commande
Cmd.CommandText = strQuery
' Execution de la commande
Set RS = Cmd.Execute
' Init compteur
Cpt = 0
' Test si résultat
If (Not RS.EOF) Then
' Il y a donc un résultat => Boucle d'affichage
While (Not RS.EOF)
ExportExcel.Enabled = True
' Affichage résultat
If (Not bTri) Then
Set liItem = lsvResult.ListItems.Add(, "K" & CStr(RS!N°), RS!Heure)
liItem.SubItems(1) = RS!Blanc
liItem.SubItems(2) = RS!Ciment_Blanc
liItem.SubItems(3) = RS!Ciment_Gris
liItem.SubItems(4) = RS!Concasse
liItem.SubItems(5) = RS!Filler
liItem.SubItems(6) = RS!MI_Casse
liItem.SubItems(7) = RS!Roule
liItem.SubItems(8) = RS!Silice
liItem.SubItems(9) = RS!silice_H
liItem.SubItems(11) = RS!Vasilogrit
End If
' Incrémente le compteur
Cpt = Cpt + 1
' Passe à l'élément suivant
RS.MoveNext
' Autorise les evenements
'DoEvents
Wend
End If
' Affichage du résultat
stbInfo.Panels("info").Text = Cpt & " Date(s) trouvée(s)"
' Libération des ressources
Set RS = Nothing
End Sub
' * Procédure recherchant si l'acteur existe
Public Function IsActeurExist(Name As String, Surname As String) As Boolean
' Retour par defaut
IsActeurExist = False
' Initialisation de la requête
strQuery = "SELECT * from Ajout WHERE Date='%' AND PRENOM='$'"
' Finition de la requête
strQuery = Replace(strQuery, "%", UCase(Trim(Name)), 1, , vbTextCompare)
strQuery = Replace(strQuery, "$", UCase(Trim(Surname)), 1, , vbTextCompare)
' Préparation de la requête
Cmd.CommandText = strQuery
' Execution de la requête
Set RS = Cmd.Execute
' Test si existance
If (RS.EOF) Then
' Libération des ressources
Set RS = Nothing
Exit Function
End If
' Retour OK
IsActeurExist = True
' Libération des ressources
Set RS = Nothing
End Function
Conclusion :
La form comporte les elements suivant:
-un textbox nommé txtSearch
-un timer nommé timer1
-un commandbutton nommé ExportExcel
-une listview nommé lsvResult
-un commandbutton nommé mnuQuitter
-une statusbar nommé stbInfo
MERCI ENCORE!!!
A voir également
- Strsearch c
- Visual Basic / VB.NET : Export d'une listview vers excel - CodeS SourceS - Guide
- Probleme avec l'exportation d'un listview vers excel ✓ - Forum - C# / .NET
- Javascript : Export html vers excel - CodeS SourceS - Guide
- Delphi / Pascal : Exporte table ver excel - CodeS SourceS - Guide
- Delphi / Pascal : Exportation access vers excel - CodeS SourceS - Guide
je veux un code simple associé a un boutton qui permet d'exporter les donnée de liste view vers excel
merci infiniment
Cela dis, c'est propre, et ouai, y a bien une trace de la source depimousse75, je confirme, je m'en suis inspiré aussi.
mais sur l'axe des ordonnées les valeurs n'etaient pas prise en compte...
Je suis en format standard pour les colones saisie pour le graphique sous excel mais ca ne marche pas, même si je change de format....
d'ailleur je te remercie.
Mais comment faire pour formater les colonnes?
Je sais pas comment faire, peux-tu m'aider?
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.