Attribute VB_Name = "ListViewDansFichier"
'****************************************************************
'*** Copier le contenu d'une ListView (report) dans un fichier***
'*** texte, HTML, CSV ou une TextBox.                         ***
'***                                                          ***
'*** Par Phil (philcam@free.fr, http://pcc.ovh.org)           ***
'***                                                          ***
'*** Exemple destiné à VB6, à retaper selon vos besoins)      ***
'*** (Le module pour trier la ListView n'est pas de moi)      ***
'****************************************************************
Option Explicit

Public Sub LViewDansFichierTxt(ByVal MaListV As ListView, _
        ByRef NomFichier As String)

Dim D As Long
Dim E As Long
Dim F As Long 'stockera les index
Dim G As Long
Dim Item_Count As Long

Item_Count = MaListV.ListItems.Count 'met en memoire pour reutiliser plus bas

'ici pour une listview à 3 colonnes
ReDim LI(Item_Count) As ListItem
ReDim SI(Item_Count) As ListSubItem
ReDim GI(Item_Count) As ListSubItem



MaListV.ListItems(1).EnsureVisible 'remonte la scrollbar a fond sinon bug!!

Open NomFichier For Output As #1

    For G = 1 To MaListV.ColumnHeaders.Count
    Print #1, MaListV.ColumnHeaders(G).Text & vbTab; 'print les titres de colonnes
    Next G
    
    Print #1, vbCrLf 'saute une ligne
    
    For D = 1 To MaListV.ListItems.Count
    
    F = MaListV.GetFirstVisible.Index
    
    Set LI(D) = MaListV.ListItems(F)
    Set SI(D) = LI(D).ListSubItems(1)
    Set GI(D) = LI(D).ListSubItems(2)
    
    Print #1, LI(D) & vbTab & SI(D) & vbTab & GI(D)  'les vbtab dependent de l'alignement à donner
    
    MaListV.ListItems.Remove (1) 'enleve la premiere ligne de la listview a chaque fois
    
    Next D
    
Close #1

    For E = 1 To Item_Count 'on rempli de nouveau la liste
    Set LI(E) = MaListV.ListItems.Add(, , LI(E))
    Set SI(E) = LI(E).ListSubItems.Add(, , SI(E))
    Set GI(E) = LI(E).ListSubItems.Add(, , GI(E))
    Next E
    
End Sub
Public Sub LViewDansFichierHtml(ByVal MaListV As ListView, _
        ByRef NomFichier As String, Optional Bordure As String = "1")

Dim D As Long
Dim E As Long
Dim F As Long
Dim G As Long
Dim Item_Count As Long

Item_Count = MaListV.ListItems.Count

ReDim LI(Item_Count) As ListItem
ReDim SI(Item_Count) As ListSubItem
ReDim GI(Item_Count) As ListSubItem

MaListV.ListItems(1).EnsureVisible

Open NomFichier For Output As #1

Print #1, "<HTML>"
Print #1, "<BODY BGCOLOR=""#000000"" TEXT=""#FFFFFF"" LINK=""#FFFF00"" VLINK=""#FFFF00"" ALINK=""#FFFF00"">"
Print #1, "<p><a href=""mailto:philcam@free.fr"">philcam@free.fr</a></p>"
Print #1, "<TABLE BORDER=" & Bordure & ">"
Print #1, "<TR>"

    For G = 1 To MaListV.ColumnHeaders.Count
    Print #1, "<TD><B>" & MaListV.ColumnHeaders(G).Text & "</B></TD>" 'print les titres de colonnes
    Next G
    
For D = 1 To MaListV.ListItems.Count

    F = MaListV.GetFirstVisible.Index

    Set LI(D) = MaListV.ListItems(F)
    Set SI(D) = LI(D).ListSubItems(1)
    Set GI(D) = LI(D).ListSubItems(2)
    
    Print #1, "<TR>"
    Print #1, "<TD>" & LI(D) & "</TD>"
    Print #1, "<TD>" & SI(D) & "</TD>"
    Print #1, "<TD>" & GI(D) & "</TD>"
    Print #1, "</TR>"
    
    MaListV.ListItems.Remove (1) 'enleve la premiere ligne de la listview a chaque fois

Next D

Print #1, "</TABLE>" 'fin de la page html
Print #1, "</HTML>"

Close #1

    For E = 1 To Item_Count 'on rempli de nouveau la liste

    Set LI(E) = MaListV.ListItems.Add(, , LI(E))
    Set SI(E) = LI(E).ListSubItems.Add(, , SI(E))
    Set GI(E) = LI(E).ListSubItems.Add(, , GI(E))

    Next E
End Sub
Public Sub LViewDansTextBox(ByVal MaListV As ListView, _
        ByRef TBX As TextBox)
        
Dim D As Long
Dim E As Long
Dim F As Long
Dim G As Long
Dim Item_Count As Long

Item_Count = MaListV.ListItems.Count

ReDim LI(Item_Count) As ListItem
ReDim SI(Item_Count) As ListSubItem
ReDim GI(Item_Count) As ListSubItem

MaListV.ListItems(1).EnsureVisible 'remonte la scrollbar a fond

    For G = 1 To MaListV.ColumnHeaders.Count
    TBX = TBX & MaListV.ColumnHeaders(G).Text & vbTab
    Next G
    
    TBX = TBX & vbCrLf & vbCrLf 'saute une ligne
    
    For D = 1 To MaListV.ListItems.Count
    
    F = MaListV.GetFirstVisible.Index
    
    Set LI(D) = MaListV.ListItems(F)
    Set SI(D) = LI(D).ListSubItems(1)
    Set GI(D) = LI(D).ListSubItems(2)
    
    TBX = TBX & LI(D) & vbTab & SI(D) & vbTab & GI(D) & vbCrLf 'les vbtab dependent de l'alignement à donner
    
    MaListV.ListItems.Remove (1) 'enleve la premiere ligne de la listview a chaque fois
    
    Next D
    
    For E = 1 To Item_Count 'on rempli de nouveau la liste
    Set LI(E) = MaListV.ListItems.Add(, , LI(E))
    Set SI(E) = LI(E).ListSubItems.Add(, , SI(E))
    Set GI(E) = LI(E).ListSubItems.Add(, , GI(E))
    Next E
    
End Sub
'Pour fichier *.csv qui s'ouvre avec EXCEL
Public Sub LViewDansFichierCsv(ByVal MaListV As ListView, _
        ByRef NomFichier As String)

Dim D As Long
Dim E As Long
Dim F As Long
Dim G As Long
Dim Item_Count As Long

Item_Count = MaListV.ListItems.Count


ReDim LI(Item_Count) As ListItem
ReDim SI(Item_Count) As ListSubItem
ReDim GI(Item_Count) As ListSubItem

MaListV.ListItems(1).EnsureVisible 'remonte la scrollbar a fond sinon bug!!

Open NomFichier For Output As #1

    For G = 1 To MaListV.ColumnHeaders.Count
    Print #1, MaListV.ColumnHeaders(G).Text & ";"; 'print les titres de colonnes
    Next G
    
    Print #1, vbCrLf 'saute une ligne
    
    For D = 1 To MaListV.ListItems.Count
    
    F = MaListV.GetFirstVisible.Index
    
    Set LI(D) = MaListV.ListItems(F)
    Set SI(D) = LI(D).ListSubItems(1)
    Set GI(D) = LI(D).ListSubItems(2)
    
    Print #1, LI(D) & ";" & SI(D) & ";" & GI(D)  'les vbtab dependent de l'alignement à donner
    
    MaListV.ListItems.Remove (1) 'enleve la premiere ligne de la listview a chaque fois
    
    Next D
    
Close #1

    For E = 1 To Item_Count 'on rempli de nouveau la liste
    Set LI(E) = MaListV.ListItems.Add(, , LI(E))
    Set SI(E) = LI(E).ListSubItems.Add(, , SI(E))
    Set GI(E) = LI(E).ListSubItems.Add(, , GI(E))
    Next E
    
End Sub

