Ajout headers et/ou enregistrements dans une ListView via lecture d'une table/Bdd

Commenter

Contenu du snippet 

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

Compatibilité : VB6, VBA

A voir également

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.

Du même auteur (cs_Exploreur)