Bonsoir,

comme je l'ai indiqué dans une discussion précédente qui a été fermée, j'ai un problème avec une listbox (dans un userform) qui "refuse" de se rafraichir.

Je vais tenter de me faire comprendre. Je tente de faire un userform de consultation d'individus dans le cadre d'une BdD de généalogie.

Sur un Userform, en cliquant sur un premier ListBox qui contient tous les individus de ma BdD, cela renseigne des Textbox et des Listbox et en particulier un listbox qui permet de voir la fratrie du personnage central. Jusque là, pas de problème.

Mon problème apparait lorsque je clique sur le listbox de la fratrie. En effet, le personnage central change bien, mais le listbox fratrie ne se raffraichit pas.

Voici les codes que j'utilise :

Pour le premier clic dans le Listbox contenant la totalité des individus :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
Private Sub ListBox_Individus_Click()
    Me.Label_ID_Consul.Caption = Me.ListBox_Individus.List(ListBox_Individus.ListIndex, 0)
    Me.Label_SOSA_Consul.Caption = Me.ListBox_Individus.List(ListBox_Individus.ListIndex, 1)
 
    Me.TextBox_Conjoint_01 = ""
    Me.TextBox_Conjoint_02 = ""
    Me.TextBox_Conjoint_03 = ""
    Me.Label_Enfants.Visible = False
    Me.ListBox_Enfants.Visible = False
 
    Application.EnableEvents = True
    MAJ_Ind_Consul
End Sub
 
Sub MAJ_Ind_Consul()
 
 
 
    Me.ListBox_Conjoints.Clear
    Set F = Sheets("BdD_Ind")
    DL = F.[A65000].End(xlUp).Row
    Set Rng = F.Range("A2:AW" & DL)
    ID_ = Me.Label_ID_Consul.Caption
    ligne_id = Application.Match(ID_, Sheets("BdD_Ind").Range("A1:A65000"), 0)
    Initial_Individu = Left(Sheets("BdD_Ind").Cells(ligne_id, [BdD_nom]).Value, 1) & Left(Sheets("BdD_Ind").Cells(ligne_id, [BdD_Prenom]).Value, 1)
 
    On Error Resume Next
    PHOTO = Initial_Individu & "_" & Sheets("BdD_Ind").Cells(ligne_id, [Bdd_Ref_Photo]).Value & ".jpg"
    If Len(PHOTO) = 7 Then
        GRDE_PHOTO = "0a.jpg"
        PHOTO = "0p.jpg"
    Else
        GRDE_PHOTO = Initial_Individu & "_" & Left(Sheets("BdD_Ind").Cells(ligne_id, [Bdd_Ref_Photo]).Value, Len(Sheets("BdD_Ind").Cells(ligne_id, [Bdd_Ref_Photo]).Value) - 1) & "a.jpg"
    End If
    Me.Label_Lien_Photo = PHOTO
    Le_chemin_de_mon_Image = ThisWorkbook.Path & "\Photos\" & Me.Label_Lien_Photo 'Images_banques\" & ComboBox1.Value & ".jpg"
    Image_Individu.Picture = LoadPicture(Le_chemin_de_mon_Image)
    On Error GoTo 0
 
    With Sheets("BdD_Ind")
        Me.Label_Nom = .Cells(ligne_id, [BdD_nom]).Value
        Me.Label_Prenom = .Cells(ligne_id, [BdD_Prenom]).Value
        Me.Label_Sexe = .Cells(ligne_id, [Bdd_Sexe]).Value
        Me.Label_Profession = .Cells(ligne_id, [Bdd_profession]).Value
        Me.Label_SOSA_Consul = .Cells(ligne_id, [Bdd_num_sosa]).Value
        'Naissance
        If .Cells(ligne_id, [Bdd_Naissance_Annee]) <> "" Then
            If .Cells(ligne_id, [Bdd_Naissance_Annee]) <> "" And .Cells(ligne_id, [BdD_Naissance_mois]) <> "" And .Cells(ligne_id, [BdD_Naissance_jour]) <> "" Then
                NAISSANCE = Format(.Cells(ligne_id, [BdD_Naissance_jour]), "00") & "/" & Format(.Cells(ligne_id, [BdD_Naissance_mois]), "00") & "/" & Format(.Cells(ligne_id, [Bdd_Naissance_Annee]), "0000")
            ElseIf .Cells(ligne_id, [Bdd_Naissance_Annee]) <> "" And .Cells(ligne_id, [BdD_Naissance_mois]) <> "" Then
                NAISSANCE = Format(.Cells(ligne_id, [BdD_Naissance_mois]), "00") & "/" & Format(.Cells(ligne_id, [Bdd_Naissance_Annee]), "0000")
            ElseIf .Cells(ligne_id, [Bdd_Naissance_Annee]) <> "" Then
                NAISSANCE = " en " & Format(.Cells(ligne_id, [Bdd_Naissance_Annee]), "0000")
            End If
        Else
            NAISSANCE = ""
        End If
        Me.Label_Naissance = NAISSANCE
        Me.Label_Ville_Naissance = .Cells(ligne_id, [BdD_Naissance_lieu])
        Me.Label_Dpmt_naissance = .Cells(ligne_id, [BdD_Naissance_dpmt])
 
        'Nbre d'union
        NB_UNION = Application.WorksheetFunction.CountIf(.Columns("A"), ID_)
 
        If NB_UNION > 3 Then
            'Rechercher ID conjoint
            Me.ListBox_Conjoints.Visible = True
            Me.Label_Unions.Visible = True
        Else
            Me.ListBox_Conjoints.Visible = False
            Me.Label_Unions.Visible = False
        End If
 
        M_Liste_Conjoints
 
        'Masque lignes vierges
        With Me.Label_Masque_Union
            If NB_UNION < 2 Then
                .Height = 72
                .Width = 500
                .Top = 240
                .Left = 120
            ElseIf NB_UNION < 3 Then
                .Height = 36
                .Width = 500
                .Top = 276
                .Left = 120
            Else
                .Height = 0
            End If
            .Caption = ""
        End With
 
 
        'Nbre enfants
        If IsError(Application.WorksheetFunction.CountIf(Sheets("BdD_ind").Columns("C"), Me.Label_ID_Consul)) Then
            NB_Enfants_M = 0
        Else
            NB_Enfants_M = Application.WorksheetFunction.CountIf(Sheets("BdD_ind").Columns("C"), Me.Label_ID_Consul)
        End If
        If IsError(Application.WorksheetFunction.CountIf(Sheets("BdD_ind").Columns("D"), Me.Label_ID_Consul)) Then
            NB_Enfants_F = 0
        Else
            NB_Enfants_F = Application.WorksheetFunction.CountIf(Sheets("BdD_ind").Columns("D"), Me.Label_ID_Consul)
        End If
 
        NB_Enfants = NB_Enfants_F + NB_Enfants_M
        If NB_Enfants > 0 Then
            Me.ListBox_Enfants.Visible = True
            Me.Label_Enfants.Visible = True
            M_Liste_Enfants
        Else
            Me.ListBox_Enfants.Visible = False
            Me.Label_Enfants.Visible = False
        End If
 
        'Nbre freres
        'Determine l'ID du PERE & mere
        M_Liste_Freres2
 
 
 
 
        'DC
        If .Cells(ligne_id, [BdD_DC_Annee]) <> "" Then
            If .Cells(ligne_id, [BdD_DC_Annee]) <> "" And .Cells(ligne_id, [BdD_DC_mois]) <> "" And .Cells(ligne_id, [BdD_DC_jour]) <> "" Then
                DC = Format(.Cells(ligne_id, [BdD_DC_jour]), "00") & "/" & Format(.Cells(ligne_id, [BdD_DC_mois]), "00") & "/" & Format(.Cells(ligne_id, [BdD_DC_Annee]), "0000")
            ElseIf .Cells(ligne_id, [BdD_DC_Annee]) <> "" And .Cells(ligne_id, [BdD_DC_mois]) <> "" Then
                DC = Format(.Cells(ligne_id, [BdD_DC_mois]), "00") & "/" & Format(.Cells(ligne_id, [BdD_DC_Annee]), "0000")
            ElseIf .Cells(ligne_id, [BdD_DC_Annee]) <> "" Then
                DC = " en " & Format(.Cells(ligne_id, [BdD_DC_Annee]), "0000")
            End If
        Else
            DC = ""
        End If
        Me.Label_Date_DC = DC
        Me.Label_Ville_DC = .Cells(ligne_id, [BdD_DC_lieu])
        Me.Label_Dpmt_DC = .Cells(ligne_id, [BdD_DC_dpmt])
 
        Me.TextBox_Notes = .Cells(ligne_id, [Bdd_Notes]).Value
        AA = Len(.Cells(ligne_id, [Bdd_Notes]).Value)
        If AA > 0 Then
            Me.TextBox_Notes.Visible = True
            Me.TextBox_Notes.SetFocus
            Me.TextBox_Notes.SelStart = 0
        Else
            Me.TextBox_Notes.Visible = False
 
        End If
        On Error Resume Next
        Me.ListBox_Individus.SetFocus
        On Error GoTo 0
    End With
 
 
 
    '...
    Me.Repaint
End Sub
Mon problème vient dans ce code lorsque je clique sur le listbox fratrie :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
Private Sub ListBox_Liste_Freres_Click()
    Me.Label_ID_Consul.Caption = Me.ListBox_Liste_Freres.List(ListBox_Liste_Freres.ListIndex, 0)
    Me.ListBox_Liste_Freres.Clear
    MAJ_Ind_Consul
 
End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Sub M_Liste_Freres()
 
    Col_Id = [BdD_Id]
    Col_Nom = [BdD_nom]
    Col_Prenom = [BdD_Prenom]
    Col_Id_Pere = [BdD_Id_Pere]
    Col_Id_Mere = [BdD_Id_Mere]
 
    LIGNE_IND = Application.Match(Me.Label_ID_Consul, Sheets("BdD_Ind").Range("A1:A65000"), 0)
    ID_PERE = Sheets("BdD_Ind").Cells(LIGNE_IND, 3).Value
    ID_MERE = Sheets("BdD_Ind").Cells(LIGNE_IND, 4).Value
 
    Set Sh = Sheets("BdD_ind")
    DL = Sh.[A65000].End(xlUp).Row
    If DL > 1 Then
        Sh.Select
        Set Rng2 = Sh.Range(Cells(2, Col_Id), Cells(DL, Col_Id_Conjoint))
        TblBD2 = Rng2.Value ' rapidité
        ColVisu2 = Array(Col_Id, Col_Prenom, Col_Nom, Col_Id_Mere, Col_Id_Pere)
        NbCol2 = UBound(ColVisu2) + 1
        ReDim TblTitreListBox2(1 To UBound(ColVisu2) + 1) 'Ubound = nbre de col.
        TitreBD2 = Application.Transpose(Rng2.Offset(-1).Resize(1).Value)
        For i = LBound(ColVisu2) To UBound(ColVisu2)
            TblTitreListBox2(i + 1) = TitreBD2(ColVisu2(i), 1)
        Next i
 
        Dim Tbl2(): N = 0
        For i = 1 To UBound(TblBD2)
            If TblBD2(i, Col_Id_Pere) = ID_PERE And TblBD2(i, Col_Id_Mere) = ID_MERE And TblBD2(i, Col_Id) <> Me.Label_ID_Consul Then
                N = N + 1
                ReDim Preserve Tbl2(1 To NbCol2, 1 To N)
                C = 0
                For Each K In ColVisu2
                    C = C + 1
                    Tbl2(C, N) = TblBD2(i, K)
                Next K
            End If
        Next i
 
        If N > 0 Then
            Me.ListBox_Liste_Freres.Column = Tbl2
 
            'Permet de supprimer les doublons des enfants qui aurait plusieurs lignes (suite à un remariage)
            RemovelstDuplicates Me.ListBox_Liste_Freres
            Me.ListBox_Liste_Freres.Visible = True
            Me.Label_Freres.Visible = True
        Else
            Me.ListBox_Liste_Freres.Visible = False
            Me.Label_Freres.Visible = False
        End If
    Else
        Unload Me
    End If
 
End Sub
Dans le code ci-dessus, la ligne de code
Code : Sélectionner tout - Visualiser dans une fenêtre à part
Me.ListBox_Liste_Freres.Column = Tbl2
n'affiche rien dans le listbox concerné lorsque l'on clic dedans...

Vous comprenez maintenant pourquoi j'avais joint mon fichier car il est plus facile d'étudier un fichier que de lire mes explications ..


Pourriez-vous SVP m'expliquer pourquoi
Code : Sélectionner tout - Visualiser dans une fenêtre à part
Me.ListBox_Liste_Freres.Column = Tbl2
fonctionne la première fois mais pas les fois suivante.

Merci d'avance !