ListBox qui semble ne pas se rafraîchir

**BGIE_29300** · 11/12/2020, 02h10

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 !

Invité · 11/12/2020, 02h45

Bonjour,

Quelque chose ne va pas ligne 27 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Dim Tbl2(): N = 0

Vous devriez avoir :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Dim Tbl2(): N = 0: Redim Tbl2(1 To NbCol2,N)

Nb : Lorsque vous utilisez Redim Preserve, il n'y a que la dernière dimension de la matrice (ici celle qui correspond à N) qui peut être modifiée.

Je n'ai pas regardé ailleurs.

**Pierre Fauconnier** · 11/12/2020, 06h46

Salut.

tu as une macro qui fait une centaine de lignes et fait plein de trucs, trop de trucs (recherche d'un jpg potentiellement inexistant => erreur, mise en forme, ...). De plus, tu as un On Error Resume Next qui va neutraliser les erreurs de code, t'empêchant de voir où se situe peut-être le problème. De plus, je n'ai pas vu de références à un tableau structuré dans ton code, alors que l'utilisation de cet outil simplifierait ton approche du code.

Perso, je découperais ce qui doit être fait en petits modules ou fonctions. Par exemple, je ne rafraîchis jamais un listbox au sein d'un évènement, mais grâce à une procédure qui utilise une fonction renvoyant les infos à afficher dans le contrôle. J'utilise une fonction qui place la photo dans le cadre mais qui ne fait que cela. De cette manière, je contrôle mon code, je peux tester chaque petite procédure et fonction indépendamment de tout le reste. Je peux alors débusquer bien plus facilement les erreurs et y remédier.

Avec le code que tu proposes, à moins de décortiquer chaque ligne et pour cela refaire quasiment ton fichier, on ne saurait pas beaucoup t'aider.

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
Option Explicit
 
Private Sub ComboBox1_Change()
  On Error GoTo Catch
  Update
 
Catch:
  If Err <> 0 Then MsgBox "L'erreur " & Err.Number & " est survenue." & vbCrLf & Err.Description, vbExclamation
End Sub
 
Sub Update()
  UpdateListBox1
  UpdateColors
  UpdatePicture
End Sub
 
Function UpdateListBox1()
  ListBox1.Value = getFamilyMembers(ComboBox1.Value)
End Function
 
Function getFamilayMembers(ParentName As String)
  ' Cette fonction renvoie un tableau que l'on peut transmettre à la propriété .Value d'un listbox
  '...
  '...
End Function
 
Sub UpdateColors()
  '...
  '...
End Sub
 
Sub UpdatePicture(Name As String)
  ' On recherche le jpg et si trouvé, on rafraichit le contrôle
  '...
  '...
End Sub

**BGIE_29300** · 11/12/2020, 10h52

Merci Eric, je vais tester votre hypothèse cet après-midi et vous tiendrai au courant.

**BGIE_29300** · 11/12/2020, 10h54

Merci Pierre pour cette réponse très pédagogue dans la façon de coder.

Si la réponse d'Eric ne règle pas mon problème, je suivrai vos indications pour tenter de résoudre mon BUG.

Bonne fin de semaine.

**BGIE_29300** · 11/12/2020, 11h00

Je n'ai pas voulu attendre et j'ai mis en pratique ce que vous m'avez indiqué, mais cela entraine un message d'erreur "L'indice n'appartient pas à la sélection" en s'arrêtant à " Tbl2(C, N) = TblBD2(i, K) "

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim Tbl2(): N = 0
        ReDim Tbl2(1 To NbCol2, N)
        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

Envoyé par BGIE_29300

Merci Eric, je vais tester votre hypothèse cet après-midi et vous tiendrai au courant.

Invité · 11/12/2020, 11h17

Envoyé par BGIE_29300

Avez-vous la possibilité de mettre un fichier zipé en ligne ? Pour ziper le fichier dans l'explorateur, clic droit Envoyer vers, Dossier compressé.

**BGIE_29300** · 11/12/2020, 11h19

Envoyé par Eric KERGRESSE

Avez-vous la possibilité de mettre un fichier zipé en ligne ? Pour ziper le fichier dans l'explorateur, clic droit Envoyer vers, Dossier compressé.

C'est très gentil à vous, je vous prépare un mini-fichier afin de vous faciliter l'analyse de mon problème.
Je vous l'envoie dès que terminé.
Encore merci !

**Pierre Fauconnier** · 11/12/2020, 11h29

Le fichier n'est pas utile à la résolution de ce problème et il ne sert à rien de le poster

Tu initialises N à 0, puis tu redimensionnes tontableau. il a donc sa seconde dimension à 0 to 0 (au passage, c'est bizarre de commencer la première dimension à 1 et la seconde à 0. Y-a-t'il une raison?)

Après, tu augmentes N mais tu ne ne redimensionnes pas N (ta ligne est en commentaires...). Il faudrait donc décommenter la ligne et ajouter le mot Preserve au second Redim...

L'idéal serait que tu expliques en français ce que tu souhaites réaliser, mais ton code, tel que présenté, suffit à comprendre que tu vas bloquer sur la ligne Tbl2(C, N) = TblBD2(i, K) puisque N va grandir alors que ta seconde dimension va rester à 0...

Invité · 11/12/2020, 11h31

Envoyé par Pierre Fauconnier

Salut Pierre,

Tu as sans doute raison, mais pour moi c'est plus simple.

**BGIE_29300** · 11/12/2020, 11h35

Voilà, je viens de réduire le fichier au maximum et surtout le formulaire.

En cliquant sur l'onglet "Consul_Indiv" mon formulaire (très réduit) de consultation apparaitra automatiquement avec là aussi un individu pré-sélectionné afin de réduire le code de cette macro.

Mon problème est donc le suivant : vous pourrez constater que dans la listbox des freres, Francois et Brigitte apparaissent. Et si je clique sur Francois, ce dernier devient bien le personnage central, mais la liste des freres n'affiche pas Eric et Brigitte... C'est donc là mon problème.

Merci d'avance pour votre aide

Envoyé par BGIE_29300

C'est très gentil à vous, je vous prépare un mini-fichier afin de vous faciliter l'analyse de mon problème.
Je vous l'envoie dès que terminé.
Encore merci !

**Pierre Fauconnier** · 11/12/2020, 11h38

Le problème du fichier joint, c'est qu'il va entrainer un échange de fichiers entre vous sur le forum, privant le demandeur de la possibilité d'être aidé par d'autres membres et de comprendre le problème posé, comme cela se passe dans la majorité de ce type de discussions sur le forum. C'est pour cela que les fichiers joints ne sont bienvenus qu'en toute dernière extrémité. La règle instaurée sur le forum a été réfléchie et établie pour cette raison.

Ici, le problème est limpide, comme je l'ai expliqué dans mon message précédent. Il ne sert donc à rien de poster le fichier sur le forum, sauf si BGIE veut du tout cuit sans comprendre, mais il s'est alors trompé de forum

**BGIE_29300** · 11/12/2020, 11h40

Merci Pierre, mais j'avoue ne pas tout comprendre ce que vous dites

.

J'ai beaucoup de mal à comprendre le fonctionnement des tableaux, même après avoir étudié les exemples de l'excellent BOISGONTIER. (à ce sujet, savez-vous ou je pourrais trouver d'autres tutos sur le sujet ?)

Je fais donc fait du copier-coller dès que je dois manipuler des tableaux en essayant (en vain comme cette-fois-ci) de trouver la bonne méthode ...

Envoyé par Pierre Fauconnier

Le fichier n'est pas utile à la résolution de ce problème et il ne sert à rien de le poster

Tu initialises N à 0, puis vous redimensionner votre tableau. il a donc sa seconde dimension à 0 to 0 (au passage, c'est bizarre de commencer la première dimension à 1 et la seconde à 0. Y-a-t'il une raison?)

Après, tu augmentes N mais tu ne ne redimensionnes pas N (ta ligne est en commentaires...). Il faudrait donc décommenter la ligne et ajouter le mot Preserve au second Redim...

L'idéal serait que tu expliques en français ce que tu souhaites réaliser, mais ton code, tel que présenté, suffit à comprendre que tu vas bloquer sur la ligne Tbl2(C, N) = TblBD2(i, K) puisque N va grandir alors que ta seconde dimension va rester à 0...

**BGIE_29300** · 11/12/2020, 11h43

Au contraire, le fait de mettre mon fichier en ligne permet à tout le monde de voir mon problème...

Pourquoi l'avoir retiré ? Eric voulait m'aider...

Envoyé par Pierre Fauconnier

Le problème du fichier joint, c'est qu'il va entrainer un échange de fichiers entre vous sur le forum, privant le demandeur de la possibilité d'être aidé par d'autres membres et de comprendre le problème posé, comme cela se passe dans la majorité de ce type de discussions sur le forum. C'est pour cela que les fichiers joints ne sont bienvenus qu'en toute dernière extrémité. La règle instaurée sur le forum a été réfléchie et établie pour cette raison.

Ici, le problème est limpide, comme je l'ai expliqué dans mon message précédent. Il ne sert donc à rien de poster le fichier sur le forum, sauf si BGIE veut du tout cuit sans comprendre, mais il s'est alors trompé de forum

**Philippe Tulliez** · 11/12/2020, 11h47

Bonjour,
Je ne suis pas un spécialiste de la généalogie mais j'aurais opté pour le contrôle TreeView

Voir ce tutoriel Créer un organigramme et un trombinoscope dans Excel

et éventuellement

Utiliser le contrôle ImageList en VBA Excel et particulièrement le chapitre III-D. Utilisation associée à un contrôle TreeView
Apprendre le TreeView en Visual Basic

Pour le reste, je ne peux que rejoindre Pierre, que je salue au passage, dans le fil #3

sur le conseil de découper votre code en petites procédures. Bien plus simple à maintenir

**Pierre Fauconnier** · 11/12/2020, 11h47

Ton profil te renseigne comme développeur informatique... ^^ Dès lors, je ne vois pas ce que tu ne comprends pas à mes explications.

Ligne 1: Dim Tbl2(): N = 0 ==> Donc N = 0
Ligne 2: ReDim Tbl2(1 To NbCol2, N) ==> Ton tableau va de 1 à nbcol2 pour la dimension 1, et de 0 à 0 pour la seconde dimension
Ligne 5: N = N + 1 ==> Donc, N va valoir 1, puis 2, puis 3... etc
Ligne 6: 'ReDim Preserve Tbl2(1 To NbCol2, 1 To N) ==> Ta ligne est commentée, donc le tableau n'est pas redimensionné et sa seconde dimension va toujours de 0 à 0
Ligne 10: Tbl2(C, N) ==> Dès que N va être plus grand que 0, ca va forcément planter. Si tu es développeur comme ton profil le dit, ça me paraît simple à comprendre.

Au passage, il n'est pas nécessaire de reprendre le message auquel tu réponds en citation

**BGIE_29300** · 11/12/2020, 11h48

Pierre, mon problème est que mon code focntionne bien la première fois même

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 tel que présenté, suffit à comprendre que tu vas bloquer sur la ligne Tbl2(C, N) = TblBD2(i, K) puisque N va grandir alors que ta seconde dimension va rester à 0...

mais pas les fois suivantes !

Depuis deux jours je tente de résoudre cela et Eric était prêt à m'aider. Pourquoi l'en empêcher ? N'est-ce pas un forum d'entraide ?

**Pierre Fauconnier** · 11/12/2020, 11h49

Envoyé par BGIE_29300

Au contraire, le fait de mettre mon fichier en ligne permet à tout le monde de voir mon problème...

Pourquoi l'avoir retiré ? Eric voulait m'aider...

Pour la raison invoquée dans la discussion de hier qui a été verrouillée pour le même problème => https://www.developpez.net/forums/d8...s-discussions/

Comme je viens de l'expliquer sur deux messages, le code suffit à comprendre le problème que tu rencontres.

**Philippe Tulliez** · 11/12/2020, 11h53

Bonjour,

Au contraire, le fait de mettre mon fichier en ligne permet à tout le monde de voir mon problème...

Une bonne explication, l'affichage d'un code "léger", un détail de l'organisation de vos données agrémenté éventuellement d'une image est largement suffisant pour vous aider

**Pierre Fauconnier** · 11/12/2020, 11h54

Envoyé par BGIE_29300

Pierre, mon problème est que mon code focntionne bien la première fois même

Forcément qu'il fonctionne la première fois puisque N = 0. C'est dès la seconde boucle que ça ne va plus, puisque tu essaies d'écrire dans la case C,1 d'un tableau qui ne va que jusque C,0 (pour la seconde dimension...

Tu dois DECOMMENTER ta ligne ReDim Preserve Tbl2(1 To NbCol2, 1 To N) (enlever l'apostrophe). De plus, lors de ce redimensionnement, tu repars de 1 to N , alors que ton tableau initial va de 0 à 0 pour la seconde dimension.

Perso, sous réserve d'autre chose, j'utiliserais ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim Tbl2(): N = 1 ' <===== On met N à 1 dès le début
        ReDim Tbl2(1 To NbCol2, 1 To N) ' <====== On redimensionne de 1 à N sur la seconde dimension
        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) ' <======= On redimensionne la seconde dimension en préservant les valeurs
                C = 0
                For Each K In ColVisu2
                    C = C + 1
                    Tbl2(C, N) = TblBD2(i, K)
                Next K
            End If
        Next i

Affiche la fenêtre des variables locales (voir Affichage). Place un point d'arrêt sur la ligne DIm tbl()... (tu cliques sur la ligne puis tu presses F9). Lance ton code et lorsque ton code arrive sur cette ligne, en jaune, presse F8 pour avancer ligne par ligne. Tu pourras voir dans la fenêtre des variables comment elles se comportent au fil du déroulement des boucles. Avec la ligne commentée (telle que présentée dans ton code de départ), tu verras que ton tableau ne grandit jamais. Si tu décommentes la ligne et que tu refais l'opération, tu verras que ton tableau grandit à chaque passage sur le second ReDim

ListBox qui semble ne pas se rafraîchir [XL-365]

Macros et VBA Excel

Discussions similaires

Partager

Partager