Public Function FillListViewFromAdoCnx(ByRef CnxAdo As ADODB.Connection, MyLv As ListView, ByVal sSql As String, Optional ByVal bHeader As Boolean = True, Optional ByVal lFirstRow As Long = 1, Optional ByVal lLastRow As Long = 0) As Boolean '****************************************************************************** '* Fonction remplissage de colonnes (headers / nom des tables) et des * '* champs avec "LIMIT" définissable dans ListView à partir * '* d'une Connexion ADO active * '* * '* ----------------------- * '* -Ajout Référence projet : Microsoft ActiveX Data Objects 2.5 Library * '* -Ajout composant : Microsoft Windows Common controls 6.0 * '* ----------------------- * '* * '* ------------ * '* Utilisation : * '* ------------ * '* les 5 premiers : * '* FillListViewFromAdoCnx CnxAdo, ListView1, Sql, , 1, 5 * ' * '* les 5 seconds : * '* FillListViewFromAdoCnx CnxAdo, ListView1, Sql, , 6, 10 * ' * '* du 11è à la fin : * '* FillListViewFromAdoCnx CnxAdo, ListView1, Sql, , 11, 0 * ' * '* tous sans Header : * '* ListView1.ColumnHeaders.Add , , "champs 1" * '* ListView1.ColumnHeaders.Add , , "champs 2" * '* FillListViewFromAdoCnx CnxAdo, ListView1, Sql, False * ' * '****************************************************************************** ' init FillListViewFromAdoCnx = False ' cnx inexistante? If CnxAdo Is Nothing Then Exit Function ElseIf Not (CnxAdo.State = adStateOpen) Then Exit Function End If ' sql vide? sSql = Trim$(sSql) If LenB(sSql) = 0 Then Exit Function ' logique rows If lFirstRow < 0 Then Exit Function ElseIf lLastRow < 0 Then Exit Function ElseIf (lLastRow > 0) And (lLastRow < lFirstRow) Then Exit Function End If ' variables Dim i As Long Dim j As Long Dim RstAdo As New ADODB.RecordSet Dim Itmx As ListItem ' init Listview If bHeader Then MyLv.ListItems.Clear: MyLv.ColumnHeaders.Clear MyLv.Visible = False On Error GoTo Lbl_Err ' Paramètres RecordSet et lancement de la requête RstAdo.CursorLocation = adUseClient RstAdo.Open sSql, CnxAdo, adOpenDynamic, adLockPessimistic ' Si il n'y a pas de champs on ne fait rien If RstAdo.Fields.Count > 0 Then ' header If bHeader Then ' on affiche forcément toutes les colonnes puisque c'est la requête qui prévoit le retour For i = 0 To RstAdo.Fields.Count - 1 MyLv.ColumnHeaders.Add , , RstAdo.Fields(i).Name Next i End If ' champs. attention!! si pas de header, il faut évidemment que la listview ait été préparée avant! If RstAdo.RecordCount > 0 Then ' 1er champ zéro = aucun champs If lFirstRow > 0 Then ' dernier champ zéro = tous, trop grand => on réduit au dernier If (lLastRow = 0) Or (lLastRow > RstAdo.RecordCount) Then lLastRow = RstAdo.RecordCount ' ajoute RstAdo.Move lFirstRow - 1 For i = lFirstRow - 1 To lLastRow - 1 Set Itmx = MyLv.ListItems.Add(, , CStr(RstAdo.Fields(0).Value)) For j = 1 To RstAdo.Fields.Count - 1 Itmx.SubItems(j) = IIf(LenB(RstAdo.Fields(j).Value) > 0, RstAdo.Fields(j).Value, vbNullString) Next j ' passe à l'enregistrement suivant If Not RstAdo.EOF Then RstAdo.MoveNext Next i ' pas d'erreur FillListViewFromAdoCnx = True Else ' pas de champs mais pas d'erreur pour autant FillListViewFromAdoCnx = True End If Else ' pas d'erreur FillListViewFromAdoCnx = True End If End If ' gestion d'erreur s'il y en a eu Lbl_Err: If Not (Err.Number = 0) Then FillListViewFromAdoCnx = False Err.Clear End If MyLv.Visible = True ' destruction objets RstAdo.Cancel If Not (RstAdo.State = adStateClosed) Then RstAdo.Close Set RstAdo = Nothing Set Itmx = Nothing End Function
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.