Manipulation ViewList en fonction de ComboBox

Re bonjour la communauté des génis :)

Je suis en train d'apprendre comment manipuler les ListView et il me semble que c'est différente des ListBox.

En effet, sur un userForm j'ai un comboBox et une listBox dans laquelle la sélection de lignes se fait en fonction de la valeur choisie dans la combobox. Voici le code : (Fichier également joint)

Private Sub ListboxRowSelect()
    Dim ii As Integer

    Application.ScreenUpdating = False

    For ii = 1 To Me.ListBox1.ListCount
        If CDate(Me.ListBox1.List(ii - 1, 1)) = CDate(ComboBox1.Value) Then
            ListBox1.ListIndex = ii - 1
            Exit For
        End If
    Next ii
End Sub

Dans le deuxième fichier joint, j'ai effacé la listBox du UserForm et l'ai remplacé par une ListView.

Le résultat attendu est :

1. Un code qui fait la même fonction dans la ListView que ce que fait celui ci-dessus dans la ListBox.

2. Un code qui fait en sorte que seuls les lignes qui correspondent à la date du comboBox soient affichées dans ma ListView.

Je vous remercie amplement,

Me

Bonjour

Pour votre listview, voici le code à placer dans l'USF

Private Sub ListView1_Click()
Dim i As Byte

TextBox1 = Me.ListView1.SelectedItem
For i = 1 To 3
    Controls("Textbox" & i + 1) = Me.ListView1.SelectedItem.ListSubItems(i)
Next i
End Sub

NB : je ne comprends pas trop le chargement des dates dans votre combobox. Est-ce pour éviter le doublon de date ?

Cordialement

Edit : votre point 2 : est-ce au chargement de l'usf vous voulez avoir la liste complète ou pas ?.

Merci Dan pour avoir pris du emps pour me répondre :)

Pour le code proposé je vais l'essayer une fois sur mon PC et reviens vers toi.

Pour la combobox oui c pour éviter les doublons de dates ... s'il y a autre moyen je suis preneur:)

Pour le point 2 oui à l'ouverture toute la liste est affichée

Pour la combobox oui c pour éviter les doublons de dates ... s'il y a autre moyen je suis preneur:)

1. Dans le début du code Private Sub UserForm_Initialize(), remplacez

Private Sub UserForm_Initialize()
Call AlimenterEtPositionnerDerligCombobox1

par ceci:

Private Sub UserForm_Initialize()
Dim c As Range
Dim tablo As Collection

On Error Resume Next
Set tablo = New Collection
With Worksheets("F1")
    For Each c In .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row)
        tablo.Add c.Value, CStr(c.Value)
    Next c
End With
On Error GoTo 0
For Each item In tablo
    Me.ComboBox1.AddItem item
Next item

Pour le point 2 oui à l'ouverture toute la liste est affichée

2. Remplacez tout le code ci-dessous

Private Sub ActualisationResultat()
Dim item As ListItem
Dim DerLig As Integer
Dim i As Integer

ListView1.ListItems.Clear
DerLig = Sheets("F1").Cells(Rows.Count, 1).End(xlUp).Row

If ComboBox1.Value = vbNullString Then
    For i = 2 To DerLig
        Set item = ListView1.ListItems.Add(Text:=Sheets("F1").Cells(i, 1))
        item.SubItems(1) = Sheets("F1").Cells(i, 2)
        item.SubItems(2) = Sheets("F1").Cells(i, 3)
        item.SubItems(3) = Sheets("F1").Cells(i, 4)
    Next i
    Exit Sub
End If

For i = 2 To DerLig
     If CDate(Sheets("F1").Cells(i, 2)) = CDate(ComboBox1.Value) Then
        Set item = ListView1.ListItems.Add(Text:=Sheets("F1").Cells(i, 1))
        item.SubItems(1) = Sheets("F1").Cells(i, 2)
        item.SubItems(2) = Sheets("F1").Cells(i, 3)
        item.SubItems(3) = Sheets("F1").Cells(i, 4)
    End If
Next i
End Sub

3. Ajoutez le code ci-dessous pour la combobox1

Private Sub ComboBox1_Change()
Call ActualisationResultat
End Sub

A vous relire

Re Dan :) c'est Nickel pour tout merci beaucoup.

Ca va me permettre d'apprendre à paramétrer les lignes et colonnes dans les ListView (je l'espère bien en tout cas).

Je reviendrai pour déposer le fichier complet (je vais travailler sur le bouton "modifier" qui permet de modifier les données de la ListView).

Me

Parcontre ya Exist Sub qui attire mon attention là !

Je connais seulement End Sub ... mais

Je vais faire mes recherches !

Parcontre ya Exist Sub qui attire mon attention là !

Je connais seulement End Sub ... mais

Oui c'est pour sortir du code lorsque la partie avant est terminée. Sans cette instruction, le code va continuer sur la boucle qui se trouve juste en dessous.
C'est un peu comme un END SUB mais placé dans le code

Cordialement

Bonsoir Dan :)

Je rencontre un nouveau problème là sur le meme fichier !

J'ai mis un TextBox5 sur le userForm qui est initializé à "jj/mm/aaaa" ... c'est là normalement ou l'on tape une date et de meme seuls les lignes correspondants de la ListView qui s'affichent.

il m'affiche donc à l'appui du bouton pour ouvrir le userForm " erreur d'exécution 13 incompatibilité de type"

Le code que j'ai mis est le suivant (le meme que tu m'as proposé mais adapté au textBox au lieu du Combobox que j'ai gardé) :

Private Sub UserForm_Initialize()

TextBox5.Text = "jj/mm/aaaa"

Dim c As Range
Dim tablo As Collection

On Error Resume Next
Set tablo = New Collection
With Worksheets("F1")
    For Each c In .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row)
        tablo.Add c.Value, CStr(c.Value)
    Next c
End With
On Error GoTo 0
For Each item In tablo
    Me.ComboBox1.AddItem item
Next item

With ListView1

.Gridlines = True
.View = lvwReport
.FullRowSelect = True
.ColumnHeaders.Add Text:=Sheets("F1").Cells(1, 1), Width:=200, Alignment:=fmAlignmentLeft
.ColumnHeaders.Add Text:=Sheets("F1").Cells(1, 2), Width:=40
.ColumnHeaders.Add Text:=Sheets("F1").Cells(1, 3), Width:=40
.ColumnHeaders.Add Text:=Sheets("F1").Cells(1, 4), Width:=20

End With

Call ActualisationResultat 

Call ActualisationResultat2

End Sub

puis :

Private Sub ActualisationResultat2()
Dim item As ListItem
Dim DerLig As Integer
Dim i As Integer

ListView1.ListItems.Clear
DerLig = Sheets("F1").Cells(Rows.Count, 1).End(xlUp).Row

If TextBox5.Value = vbNullString Then
    For i = 2 To DerLig
        Set item = ListView1.ListItems.Add(Text:=Sheets("F1").Cells(i, 1))
        item.SubItems(1) = Sheets("F1").Cells(i, 2)
        item.SubItems(2) = Sheets("F1").Cells(i, 3)
        item.SubItems(3) = Sheets("F1").Cells(i, 4)
    Next i
    Exit Sub
End If

For i = 2 To DerLig
     If CDate(Sheets("F1").Cells(i, 2)) = CDate(TextBox5.Value) Then
        Set item = ListView1.ListItems.Add(Text:=Sheets("F1").Cells(i, 1))
        item.SubItems(1) = Sheets("F1").Cells(i, 2)
        item.SubItems(2) = Sheets("F1").Cells(i, 3)
        item.SubItems(3) = Sheets("F1").Cells(i, 4)
    End If
Next i
End Sub

Je pense que le problème vient du format date ! ...

pour textbpx5 j'ai mis ce code :

Private Sub TextBox5_Enter()
If TextBox5 = "jj/mm/aaaa" Then
TextBox5 = ""
End If
End Sub

Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox5 = "" Then
TextBox5 = "jj/mm/aaaa"
End If
End Sub

Private Sub TextBox5_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not ((KeyAscii > 46 And KeyAscii < 58)) Then
KeyAscii = 0
End If
End Sub

Pourrais-tu examiner ceci stp ça fait des heures que je suis bloqué à ce niveau :)

Merci

Bonjour,

Pourquoi ajouter une textbox ? Vous compliquez je pense

En modifiant un peu le code, vous pourriez utiliser la combo pour faire ce choix et ce , d'autant que les dates sont déjà dans la combo

Crdlt

Bonjour Dan

En effet avec la comboBox c'est pour tester la consultation des enregistrement et leur modification.

maintenant je me place dans une situation de saisie, où l'utilisateur doit saisir une date sous format jj/mm/aaaa dans le textBox ...

en effet si j'enlève le paramètrage de jj/mm/aaaa quand je tape une date j'ai les lignes qui correspondent à la date, mais avec jj/mm/aaaa ça ne marche plus.

y a t il quelque chose à modfier dans (Private SubUserForm_Initialize()) ou (Private Sub ActualisationResultat2()) qui pourrait m'éviter ce blocage s'il te plait ?

Merci

Hum... on va faire plus simple et garder votre textbox5.
Faites ceci :

1. Un oubli. Rajoutez ceci dans la déclaration des variables de la Private Sub UserForm_Initialize()

Dim item

2. Supprimez les macros suivantes :
- Private Sub ActualisationResultat2
- Private Sub TextBox5_Enter
- Private Sub TextBox5_Exit

3. Remplacez le code Private Sub TextBox5_AfterUpdate par celui ci

Private Sub TextBox5_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(TextBox5.Value) Or Len(TextBox5) < 10 Then
    MsgBox ("Le format introduit n'est pas valide, le format de date est jj/mm/aaaa!")
    TextBox5 = vbNullString
    Exit Sub
End If
ComboBox1.Value = TextBox5.Value
End Sub

4. Si vous voulez vider facilement la textbox avant d'entre unne date, vous pourriez le faire en faisant un double click dans la textbox. Si intéressé, ajoutez ce code dans l'USF

Private Sub TextBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox5 = vbnullstring
End Sub

Faites un test

EDIT : remplacé code Afterupdate par Beforeupdate

Bonjour Dan :)

Merci pour ton appui, ça marche. J'ai mis en pièce jointe ta proposition (la version V2)

De mon côté j'ai trouvé une solution "bricolage" : j'ai créé un textBox6 invisible qui s'adapte sur TextBox5 Exit :

Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox5 = "" Then
TextBox5 = "jj/mm/aaaa"
End If

If TextBox5 <> "jj/mm/aaaa" Then
TextBox6 = TextBox5
End If

Call ActualisationResultat2

End Sub

Du coup le code de l'actualisation de la ListView tient compte de la TextBox6 et non plus de la textBox5 : (pièce jointe version V3)

Private Sub ActualisationResultat2()
Dim item As ListItem
Dim DerLig As Integer
Dim i As Integer

ListView1.ListItems.Clear
DerLig = Sheets("F1").Cells(Rows.Count, 1).End(xlUp).Row

If TextBox6.Value = vbNullString Then
    For i = 2 To DerLig
        Set item = ListView1.ListItems.Add(Text:=Sheets("F1").Cells(i, 1))
        item.SubItems(1) = Sheets("F1").Cells(i, 2)
        item.SubItems(2) = Sheets("F1").Cells(i, 3)
        item.SubItems(3) = Sheets("F1").Cells(i, 4)
    Next i
    Exit Sub
End If

For i = 2 To DerLig
     If CDate(Sheets("F1").Cells(i, 2)) = CDate(TextBox6.Value) Then
        Set item = ListView1.ListItems.Add(Text:=Sheets("F1").Cells(i, 1))
        item.SubItems(1) = Sheets("F1").Cells(i, 2)
        item.SubItems(2) = Sheets("F1").Cells(i, 3)
        item.SubItems(3) = Sheets("F1").Cells(i, 4)
    End If
Next i
End Sub

Bien cordialement,

Sujet résolu,

Merci