Permet de sauvegarder le contenu d'une ListView dans
un fichier texte et de le relire par la suite pour remplir
une (autre) ListView
La sauvegarde peut aussi ce faire en HTML ou dans un format
compréhensible par EXCEL
Cette nouvelle version fonctionne avec un format de fichier INI permetant d'utiliser
les API d'acces direct a ces fichiers
il est possible de sauvegarder les images est le style de chaque ligne
l'apparence de la liste est également sauvegardée
L'extention des ces fichiers est LVW, ceci permet d'associer un programme pour
ouvrir directement des images de ListView vb
en double cliquant dessus depuis l'explorateur
Attention contraiment a ce qui ce passe sous WinNT l'API WritePrivateProfileString
ne semble pas acepter les tabulations, j'ai donc remplacé
le séparateur utilisé par un | (Alt Gr + 6), celui ci ne doit
donc pas se trouver dans un des champs text sauvegardés (item.text .tag
.key ...)
comme ce caractère est tres peu utilisé cela ne devrait pas trop
géner
La sauvegarde en HTML et en fichier CSV utilise elle l'objet FileSystemObject qui ne marche que sous VB6
Aucune autre limite la listview obtenue est la replique exacte de celle sauvegardée
( Sources convertis en 6 couleurs avec mon programme VB to HTML)
'===========================================================================
'Active Visual Basic
'http://www.fredjust.com
'===========================================================================
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias _
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias _
"WritePrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As String, _
ByVal lpString As String, _
ByVal lpFileName As String) As Long
Fonction de sauvegarde
'===========================================================================
' SAVE A LIST VIEW IN A LVW TEXT FILE
'===========================================================================
Public Sub lvSaveToFile(ByVal LV As ListView, ByRef FileName As String)
Dim i As Long
Dim j As Long
Dim lng As Long
Dim tempo As String
On Error Resume Next
'erase file if exist
Kill FileName
'write file info type
WritePrivateProfileString "FileInfo", "Type", "LVW FILE", FileName
WritePrivateProfileString "FileInfo", "Version", "1.0", FileName
With LV
WritePrivateProfileString "ListView", "Appearance", .Appearance, FileName
WritePrivateProfileString "ListView", "BackColor", .BackColor, FileName
WritePrivateProfileString "ListView", "BorderStyle", .BorderStyle, FileName
WritePrivateProfileString "ListView", "Checkboxes", BoolToStr(.Checkboxes), FileName
WritePrivateProfileString "ListView", "FlatScrollBar", BoolToStr(.FlatScrollBar), FileName
WritePrivateProfileString "ListView", "ForeColor", .ForeColor, FileName
WritePrivateProfileString "ListView", "FullRowSelect", BoolToStr(.FullRowSelect), FileName
WritePrivateProfileString "ListView", "GridLines", BoolToStr(.GridLines), FileName
WritePrivateProfileString "ListView", "HideColumnHeaders", BoolToStr(.HideColumnHeaders), FileName
WritePrivateProfileString "ListView", "HideSelection", BoolToStr(.HideSelection), FileName
WritePrivateProfileString "ListView", "HotTracking", BoolToStr(.HotTracking), FileName
WritePrivateProfileString "ListView", "HoverSelection", BoolToStr(.HoverSelection), FileName
WritePrivateProfileString "ListView", "LabelEdit", .LabelEdit, FileName
WritePrivateProfileString "ListView", "Sorted", BoolToStr(.Sorted), FileName
WritePrivateProfileString "ListView", "SortKey", .SortKey, FileName
WritePrivateProfileString "ListView", "SortOrder", .SortOrder, FileName
WritePrivateProfileString "ListView", "Tag", .Tag, FileName
WritePrivateProfileString "ListView", "View", .View, FileName
'save ColumHeaders
WritePrivateProfileString "ColumHeaders", "Count", .ColumnHeaders.Count, FileName
For i = 1 To .ColumnHeaders.Count
tempo = .ColumnHeaders(i).Text
tempo = tempo & "|" & .ColumnHeaders(i).Key
tempo = tempo & "|" & .ColumnHeaders(i).Tag
tempo = tempo & "|" & .ColumnHeaders(i).Width
tempo = tempo & "|" & .ColumnHeaders(i).Alignment
lng = .ColumnHeaders(i).Icon
tempo = tempo & "|" & CStr(lng)
WritePrivateProfileString "ColumHeaders", "Colum" & CStr(i), tempo, FileName
Next
'save ListItems
WritePrivateProfileString "ListItems", "Count", .ListItems.Count, FileName
For i = 1 To .ListItems.Count
tempo = .ListItems(i).Text
For j = 1 To LV.ColumnHeaders.Count - 1
tempo = tempo & "|" & .ListItems(i).SubItems(j)
Next
'save ListItems text and subItems
WritePrivateProfileString "ListItems", "ItemText" & CStr(i), tempo, FileName
tempo = .ListItems(i).Key
tempo = tempo & "|" & .ListItems(i).Tag
tempo = tempo & "|" & .ListItems(i).ToolTipText
lng = .ListItems(i).SmallIcon
tempo = tempo & "|" & CStr(lng)
tempo = tempo & "|" & .ListItems(i).ForeColor
tempo = tempo & "|" & BoolToStr(.ListItems(i).Bold)
tempo = tempo & "|" & BoolToStr(.ListItems(i).Checked)
tempo = tempo & "|" & BoolToStr(.ListItems(i).Ghosted)
'save ListItems other options
WritePrivateProfileString "ListItems", "ItemOption" & CStr(i), tempo, FileName
Next
End With
End Sub
Fonction de lecture
'===========================================================================
' LOAD A LIST VIEW FROM A LVW FILE
'===========================================================================
Public Function lvLoadFromFile(ByVal LV As ListView, ByRef FileName As String, _
Optional ByVal LoadColums As Boolean = True, _
Optional ByVal LoadListViewStyle As Boolean = True, _
Optional ByVal LoadItemsOptions As Boolean = True) As Long
Dim i As Long
Dim j As Long
Dim lng As Long
Dim tempo As String
Dim champs
Dim colonne As ColumnHeader
Dim Ligne As ListItem
On Error Resume Next
'check file type
If ReadIniFile(FileName, "FileInfo", "Type", "") <> "LVW FILE" Then
lvLoadFromFile = -1
Exit Function
End If
With LV
.Visible = False
.ListItems.Clear
If LoadListViewStyle Then
.Appearance = ReadIniFile(FileName, "ListView", "Appearance", .Appearance)
.BackColor = ReadIniFile(FileName, "ListView", "BackColor", .BackColor)
.BorderStyle = ReadIniFile(FileName, "ListView", "BorderStyle", .BorderStyle)
.Checkboxes = ReadIniFile(FileName, "ListView", "Checkboxes", .Checkboxes)
.FlatScrollBar = ReadIniFile(FileName, "ListView", "FlatScrollBar", .FlatScrollBar)
.ForeColor = ReadIniFile(FileName, "ListView", "ForeColor", .ForeColor)
.FullRowSelect = ReadIniFile(FileName, "ListView", "FullRowSelect", .FullRowSelect)
.GridLines = ReadIniFile(FileName, "ListView", "GridLines", .GridLines)
.HideColumnHeaders = ReadIniFile(FileName, "ListView", "HideColumnHeaders", .HideColumnHeaders)
.HideSelection = ReadIniFile(FileName, "ListView", "HideSelection", .HideSelection)
.HotTracking = ReadIniFile(FileName, "ListView", "HotTracking", .HotTracking)
.HoverSelection = ReadIniFile(FileName, "ListView", "HoverSelection", .HoverSelection)
.LabelEdit = ReadIniFile(FileName, "ListView", "LabelEdit", .LabelEdit)
.Sorted = ReadIniFile(FileName, "ListView", "Sorted", .Sorted)
.SortKey = ReadIniFile(FileName, "ListView", "SortKey", .SortKey)
.SortOrder = ReadIniFile(FileName, "ListView", "SortOrder", .SortOrder)
.Tag = ReadIniFile(FileName, "ListView", "Tag", .Tag)
.View = ReadIniFile(FileName, "ListView", "View", .View)
End If
If LoadColums Then
'read ColumHeaders
lng = ReadIniFile(FileName, "ColumHeaders", "Count", "0")
For i = 1 To lng
champs = Split(ReadIniFile(FileName, "ColumHeaders", "Colum" & CStr(i), ""), "|")
If LV.ColumnHeaders.Count <= i Then
Set colonne = LV.ColumnHeaders.Add()
Else
Set colonne = LV.ColumnHeaders(i)
End If
With colonne
.Text = champs(0)
.Key = champs(1)
.Tag = champs(2)
.Width = champs(3)
.Alignment = champs(4)
.Icon = CLng(champs(5))
End With
Next
End If
'read ListItems
lng = ReadIniFile(FileName, "ListItems", "Count", "0")
.Visible = False
.ListItems.Clear
.Visible = True
For i = 1 To lng
'read ListItems text and subItems
champs = Split(ReadIniFile(FileName, "ListItems", "ItemText" & CStr(i), ""), "|")
Set Ligne = LV.ListItems.Add(, , champs(0))
With Ligne
For j = 1 To UBound(champs)
.SubItems(j) = champs(j)
Next
If LoadItemsOptions Then
'load ListItems another options
champs = Split(ReadIniFile(FileName, "ListItems", "ItemOption" & CStr(i), ""), "|")
.Key = champs(0)
.Tag = champs(1)
.ToolTipText = champs(2)
.SmallIcon = CLng(champs(3))
.ForeColor = champs(4)
.Bold = champs(5)
.Checked = champs(6)
.Ghosted = champs(7)
End If
End With
Next
.Visible = True
End With
lvLoadFromFile = Err.Number
End Function
Sauvegarde en HTML
'===========================================================================
' SAVE A LIST VIEW IN A HTML FILE
'===========================================================================
Public Sub lvSaveToHtmlFile(ByVal LV As ListView, ByRef FileName As String, _
Optional Border As String = "1")
Dim i As Long
Dim j As Long
Dim lng As Long
Dim tempo As String
Dim FSO As New FileSystemObject
Dim TXTstream As TextStream
On Error Resume Next
Set TXTstream = FSO.CreateTextFile(FileName)
With TXTstream
.WriteLine "<HTML>"
.WriteLine "<BODY BGCOLOR=""#FFFFFF"" TEXT=""#000000"" LINK=""#000080"" VLINK=""#800080"" ALINK=""#FF0000"">"
.WriteLine Chr(9) & "<TABLE BORDER=" & Border & ">"
.WriteLine Chr(9) & Chr(9) & "<TR>"
For i = 1 To LV.ColumnHeaders.Count
.WriteLine Chr(9) & Chr(9) & Chr(9) & "<TD><B>" & CStr(LV.ColumnHeaders(i).Text) & "</B></TD>"
.WriteLine Chr(9) & Chr(9) & "</TR>"
For i = 1 To LV.ListItems.Count
.WriteLine Chr(9) & Chr(9) & "<TR>"
.WriteLine Chr(9) & Chr(9) & Chr(9) & "<TD>" & LV.ListItems(i).Text & "</TD>"
For j = 1 To LV.ColumnHeaders.Count - 1
.WriteLine Chr(9) & Chr(9) & Chr(9) & "<TD>" & CStr(LV.ListItems(i).SubItems(j)) & "</TD>"
Next
.WriteLine Chr(9) & Chr(9) & "</TR>"
Next
.WriteLine Chr(9) & "</TABLE>"
.WriteLine "</HTML>"
.Close
End With
End Sub
sauvegarde en CSV (text séparateur tabulation)
'===========================================================================
' SAVE A LIST VIEW IN A CSV FILE OPENABLE WITH EXCEL
'===========================================================================
Public Sub lvSaveToExcelFile(ByVal LV As ListView, ByRef FileName As String)
Dim i As Long
Dim j As Long
On Error Resume Next
Dim FSO As New FileSystemObject
Dim TXTstream As TextStream
Set TXTstream = FSO.CreateTextFile(FileName)
With TXTstream
For i = 1 To LV.ColumnHeaders.Count - 1
.Write CStr(LV.ColumnHeaders(i).Text) & Chr(9)
Next
.WriteLine CStr(LV.ColumnHeaders(LV.ColumnHeaders.Count).Text)
For i = 1 To LV.ListItems.Count - 1
.Write LV.ListItems(i).Text & Chr(9)
For j = 2 To LV.ColumnHeaders.Count - 1
.Write LV.ListItems(i).SubItems(j - 1) & Chr(9)
Next
.WriteLine LV.ListItems(i).SubItems(LV.ColumnHeaders.Count - 1)
Next
.Close
End With
Set TXTstream = Nothing
Set FSO = Nothing
End Sub
'===========================================================================
' SAVE A LIST VIEW IN A CSV FILE OPENABLE WITH EXCEL
'===========================================================================
Public Sub lvLoadFromCsvFile(ByVal LV As ListView, ByRef FileName As String, _
separateur As String)
Dim i As Long
Dim LigneTexte As String
Dim ColonneTexte
Dim Ligne As ListItem
On Error Resume Next
Dim FSO As New FileSystemObject
Dim TXTstream As TextStream
Set TXTstream = FSO.OpenTextFile(FileName)
LV.ListItems.Clear
Do
LigneTexte = TXTstream.ReadLine
ColonneTexte = Split(LigneTexte, separateur)
Set Ligne = LV.ListItems.Add(, , ColonneTexte(0))
For i = 1 To UBound(ColonneTexte)
Ligne.SubItems(i) = ColonneTexte(i)
Next
Loop Until TXTstream.AtEndOfStream
Set TXTstream = Nothing
Set FSO = Nothing
End Sub