1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Exporter listview vers excel

Exporter listview vers excel

Soyez le premier à donner votre avis sur cette source.

Snippet vu 11 497 fois - Téléchargée 44 fois

Commenter

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!

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

Ajouter un commentaire Commentaires
cs_miiimou
Messages postés
4
Date d'inscription
samedi 30 janvier 2010
Statut
Membre
Dernière intervention
22 mars 2010
7 mars 2010 à 19:01
florian , merci pour le code mais il ne marche pas

je veux un code simple associé a un boutton qui permet d'exporter les donnée de liste view vers excel

merci infiniment
cs_Duanra
Messages postés
26
Date d'inscription
samedi 22 février 2003
Statut
Membre
Dernière intervention
13 janvier 2005
13 juil. 2003 à 19:28
Y manque un zip...?
Cela dis, c'est propre, et ouai, y a bien une trace de la source depimousse75, je confirme, je m'en suis inspiré aussi.
Mumuri
Messages postés
320
Date d'inscription
mercredi 9 octobre 2002
Statut
Membre
Dernière intervention
6 avril 2008
12 oct. 2002 à 11:41
merci
florian37
Messages postés
56
Date d'inscription
dimanche 13 janvier 2002
Statut
Membre
Dernière intervention
8 décembre 2008
24 sept. 2002 à 22:57
J'ai remarqué que sur l'axe des abscisses les valeurs etaient correct,
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....
florian37
Messages postés
56
Date d'inscription
dimanche 13 janvier 2002
Statut
Membre
Dernière intervention
8 décembre 2008
24 sept. 2002 à 22:43
Oui exactement, je me suis inspiré de TA source :c)
d'ailleur je te remercie.

Mais comment faire pour formater les colonnes?
Je sais pas comment faire, peux-tu m'aider?
Afficher les 6 commentaires
S'inscrire maintenant

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.