1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
|
'
'==============================================================
' Remplissage d'un Listview avec le résultat d'une requête
'==============================================================
Public Sub RequeteDansListView(myLv As ListView, _
myQuery As String, _
myDB As ADODB.Connection, _
Optional autosize As Boolean = False)
Dim RS As New ADODB.Recordset
Dim ff As ADODB.Field
Dim II As Long
Dim JJ As Long
Dim Counter As Double
Dim libErreur As String
Dim colNew As ColumnHeader
Dim newLine As ListItem
Dim maValeur As String
'
'------------------------------------------------------
' Destruction du Lv s'il est déjà chargé
'------------------------------------------------------
With myLv
.ListItems.Clear
For II = myLv.ColumnHeaders.Count To 1 Step -1
myLv.ColumnHeaders.Remove (II)
Next II
End With
'
'-----------------------------------------------------
' Exécution de la requête
'-----------------------------------------------------
On Error Resume Next
Err.Clear
RS.Open myQuery, myDB, adOpenStatic, adLockReadOnly
If Err.Number <> 0 Then
MsgBox "Code Erreur : " & Err.Number & vbCrLf & vbCrLf _
& "Description : " & Err.Description & vbCrLf
GoTo Fin
End If
On Error GoTo 0
'
'-----------------------------------------------
' Chargement du listview
'-----------------------------------------------
With myLv
'
'-----------------------------------------
' Création des titres de colonnes
'-----------------------------------------
For Each ff In RS.Fields
Set colNew = .ColumnHeaders.Add(, , ff.Name, 90)
Next ff
'
'-----------------------------------------
' Lignes de données
'-----------------------------------------
JJ = 0
If Not RS.EOF Then
RS.MoveFirst
'
'-------------------------------------
' Pour chaque ligne
'-------------------------------------
While Not RS.EOF
JJ = JJ + 1
Counter = 0
'
'---------------------------------
' Pour chaque colonne
'---------------------------------
For II = 0 To RS.Fields.Count - 1
If Not IsNull(RS.Fields(II).Value) Then
maValeur = Trim(RS.Fields(II).Value)
Else
maValeur = ""
End If
'
'-----------------------------
' S'il s'agit de la première
' colonne, on crée une
' nouvelle ligne (Item)
'-----------------------------
If Counter = 0 Then
Set newLine = .ListItems.Add(, , maValeur)
'
'-----------------------------
' Sinon on renseigne la
' valeur de la colonne suivante
' (subitem) pour la ligne en cours
'-----------------------------
Else
newLine.SubItems(Counter) = maValeur
End If
Counter = Counter + 1
Next II
RS.MoveNext
Wend
myLv.Refresh
End If
If autosize Then AutoSizeLV myLv
End With
'
Fin:
RS.Close
Set RS = Nothing
End Sub
'
'========================================================
' Autosize des colonnes d'un ListView
'========================================================
Public Sub AutoSizeLV(LV As ListView)
Dim myColumn As ColumnHeader
'
For Each myColumn In LV.ColumnHeaders
SendMessage LV.hWnd, _
LVM_FIRST + 30, _
myColumn.index - 1, _
-1
Next
LV.Refresh
End Sub |
Partager