Ajout dynamique de Combo Box

Version imprimable

Bonjour a tous!

J'ai un petit souci lors de mon remplissage de mes ComboBox qui ont ete rajoutees dynamiquement dans un UserForm.

Dans mon UserForm, j'ai un bouton qui en cliquant permet d'agrandir mon UserForm et rajoute des ComboBox. Jusque la, tout marche bien.
Par contre, ces nouvelles ComboBox, je souhaite les remplir, donc je creer des variables declaree en tant que String (cf dans mon code ci dessous: str_CodeCBmonth, str_CodeCByear et str_CodeCBday), puis j'insere le tout dans le CodeModule.

Voila le code:

Code:

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
Option Explicit
Dim tab_Cust() As String, n_CList As Integer, n_Country As Integer, n_LigneCb As Byte
Dim n_Mois As Byte, n_Annee As Byte, n_LigneJour As Byte, n_x As Integer
Dim ck_Aim As Boolean, str_DNumber As String
 
 
Private Sub bt_Add_Click()
Dim ctr_Day As Control, ctr_Month As Control, ctr_Year As Control
Dim cl As Classe1
Dim n_gap As Integer, str_CodeCBmonth As String, str_CodeCByear As String, str_CodeCBday As String
 
Set co_ColCbBx = New Collection
 
n_LigneCb = n_LigneCb + 1
n_gap = 24
 
Set ctr_Day = fm_Payment.MultiPage1.Pages(1).Controls.Add("forms.ComboBox.1", "cb_Day" & n_LigneCb, True)
Set ctr_Month = fm_Payment.MultiPage1.Pages(1).Controls.Add("forms.ComboBox.1", "cb_Month" & n_LigneCb, True)
Set ctr_Year = fm_Payment.MultiPage1.Pages(1).Controls.Add("forms.ComboBox.1", "cb_Year" & n_LigneCb, True)
 
With ctr_Day
    .Height = 18
    .Left = 78
    .Top = 60 + (n_LigneCb - 1) * n_gap
    .Width = 36
End With
With ctr_Month
    .Height = 18
    .Left = 24
    .Top = 60 + (n_LigneCb - 1) * n_gap
    .Width = 36
End With
With ctr_Year
    .Height = 18
    .Left = 132
    .Top = 60 + (n_LigneCb - 1) * n_gap
    .Width = 60
End With
 
 
With fm_Payment
    With .MultiPage1.Pages(1)
        .Label7.Top = 114 + (n_LigneCb - 1) * n_gap
        .tb_Comment.Top = 138 + (n_LigneCb - 1) * n_gap
    End With
    .MultiPage1.Height = 300 + (n_LigneCb - 1) * n_gap
    .bt_Pmt.Top = 324 + (n_LigneCb - 1) * n_gap
    .bt_Cancel.Top = 324 + (n_LigneCb - 1) * n_gap
    .Height = 382.5 + (n_LigneCb - 1) * n_gap
End With
 
Debug.Print ctr_Month.Name
Set cl = New Classe1
Set cl.CbBx = ctr_Month
co_ColCbBx.Add cl
Set cl.CbBx = ctr_Year
co_ColCbBx.Add cl
Set cl.CbBx = ctr_Day
co_ColCbBx.Add cl
 
str_CodeCBmonth = "Private Sub cb_Month" & n_LigneCb & "_DropButtonClick()" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "Dim i As Integer" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "fm_Payment.cb_Month" & n_LigneCb & ".Clear" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "For i = 1 To " & n_Mois & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "fm_Payment.cb_Month" & n_LigneCb & ".AddItem (sh_Data.Cells(i, 3))" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "Next i" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "End Sub"
 
str_CodeCByear = "Private Sub cb_Year" & n_LigneCb & "_DropButtonClick()" & vbCrLf
str_CodeCByear = str_CodeCByear & "Dim i As Integer" & vbCrLf
str_CodeCByear = str_CodeCByear & "fm_Payment.cb_Year" & n_LigneCb & ".Clear" & vbCrLf
str_CodeCByear = str_CodeCByear & "For i = 1 To " & n_Annee & vbCrLf
str_CodeCByear = str_CodeCByear & "fm_Payment.cb_Year" & n_LigneCb & ".AddItem (sh_Data.Cells(i, 5))" & vbCrLf
str_CodeCByear = str_CodeCByear & "Next i" & vbCrLf
str_CodeCByear = str_CodeCByear & "End Sub"
 
str_CodeCBday = "Private Sub cb_Month" & n_LigneCb & "_Change()" & vbCrLf
str_CodeCBday = str_CodeCBday & "Dim i As Integer" & vbCrLf
str_CodeCBday = str_CodeCBday & "n_LigneJour = sh_Data.Cells(WorksheetFunction.Match(fm_Payment.cb_Month" & n_LigneCb & ".Value, sh_Data.Columns(3), 0), 4).Value" & vbCrLf
str_CodeCBday = str_CodeCBday & "fm_Payment.cb_Day" & n_LigneCb & ".Clear" & vbCrLf
str_CodeCBday = str_CodeCBday & "For i = 1 To n_LigneJour" & vbCrLf
str_CodeCBday = str_CodeCBday & "fm_Payment.cb_Day" & n_LigneCb & ".AddItem (sh_Data.Cells(i, 5))" & vbCrLf
str_CodeCBday = str_CodeCBday & "Next i" & vbCrLf
str_CodeCBday = str_CodeCBday & "End Sub"
 
With ThisWorkbook.VBProject.VBComponents("fm_Payment").codemodule
    n_x = .countoflines + 1
    .createeventproc
    .InsertLines n_x, str_CodeCBmonth
    .InsertLines n_x + 8, str_CodeCByear
    .InsertLines n_x + 16, str_CodeCBday
End With
 
End Sub

le code qui s'insere quand je clique sur mon bouton pour ajouter semble pourtant correct, si je clique une seule fois sur mon bouton, le voici ce qui s'insere:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub cb_Month2_DropButtonClick()
Dim i As Integer
fm_Payment.cb_Month2.Clear
For i = 1 To 12
fm_Payment.cb_Month2.AddItem (sh_Data.Cells(i, 3))
Next i
End Sub
Private Sub cb_Year2_DropButtonClick()
Dim i As Integer
fm_Payment.cb_Year2.Clear
For i = 1 To 3
fm_Payment.cb_Year2.AddItem (sh_Data.Cells(i, 5))
Next i
End Sub
Private Sub cb_Month2_Change()
Dim i As Integer
n_LigneJour = sh_Data.Cells(WorksheetFunction.Match(fm_Payment.cb_Month2.Value, sh_Data.Columns(3), 0), 4).Value
fm_Payment.cb_Day2.Clear
For i = 1 To n_LigneJour
fm_Payment.cb_Day2.AddItem (sh_Data.Cells(i, 5))
Next i
End Sub

j'ai bien fait un Debug.Print pour savoir quel etaient les noms de mes ComboBox crees, et si je clique une seule fois, c'est bien cb_Month2, cb_Year2 et cb_Day2

quand je deroule ma ComboBox, c'est vide...
Impossible de comprendre pourquoi ca ne remplit pas, je seche completement :(
Ce code qui s'inscrit est strictement le meme que pour d'autres ComboBox qui sont deja presentes au lancement du UserForm, et c'est bien rempli, donc le probleme ne vient pas de la reference sh_Data.Cells(i, 3) ou sh_Data.Cells(i, 5)

J'espere que vous pourrez m'aider!
si besoin je peux envoyer mon fichier.

Merci pour votre aide!

Je viens de modifier un peu mon code pour le rendre plus clair et j'y ai ajoute quelques notes:

Code:

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
Option Explicit
Dim tab_Cust() As String, n_CList As Integer, n_Country As Integer, n_LigneCb As Byte
Dim n_Mois As Byte, n_Annee As Byte, n_LigneJour As Byte, n_x As Integer
Dim ck_Aim As Boolean, str_DNumber As String
 
 
Private Sub bt_Add_Click()
Dim tab_ctrMDY(2) As Control, tab_nameMDY(2) As String, i As Integer
Dim cl As Classe1
Dim n_gap As Integer, str_CodeCBmonth As String, str_CodeCByear As String, str_CodeCBday As String
 
With fm_Payment
    With .MultiPage1.Pages(1)
        .Label7.Top = 114 + (n_LigneCb - 1) * n_gap
        .tb_Comment.Top = 138 + (n_LigneCb - 1) * n_gap
    End With
    .MultiPage1.Height = 300 + (n_LigneCb - 1) * n_gap
    .bt_Pmt.Top = 324 + (n_LigneCb - 1) * n_gap
    .bt_Cancel.Top = 324 + (n_LigneCb - 1) * n_gap
    .Height = 382.5 + (n_LigneCb - 1) * n_gap
End With
 
Set co_ColCbBx = New Collection
 
n_LigneCb = n_LigneCb + 1
n_gap = 24
tab_nameMDY(0) = "cb_Month"
tab_nameMDY(1) = "cb_Day"
tab_nameMDY(2) = "cb_Year"
 
'==========>Boucle pour creer les 3 ComboBox
For i = 1 To 3
    Set tab_ctrMDY(i - 1) = fm_Payment.MultiPage1.Pages(1).Controls.Add("forms.ComboBox.1", tab_nameMDY(i - 1) & n_LigneCb, True)
 
    With tab_ctrMDY(i - 1)
        .Height = 18
        .Left = 24 + 54 * (i - 1)
        .Top = 60 + (n_LigneCb - 1) * n_gap
        If i <> 3 Then
            .Width = 36
        Else
            .Width = 60
        End If
    End With
 
    Debug.Print tab_ctrMDY(i - 1).Name
 
    '==========> ici je rajoute l'objet dans la classe
    Set cl = New Classe1
    Set cl.CbBx = tab_ctrMDY(i - 1)
    co_ColCbBx.Add cl
Next i
 
'==========> ici je definis le code qui va s'inscrire
 
str_CodeCBmonth = "Private Sub cb_Month" & n_LigneCb & "_DropButtonClick()" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "Dim i As Integer" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "fm_Payment.cb_Month" & n_LigneCb & ".Clear" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "For i = 1 To " & n_Mois & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "fm_Payment.cb_Month" & n_LigneCb & ".AddItem (sh_Data.Cells(i, 3))" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "Next i" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "End Sub"
 
str_CodeCByear = "Private Sub cb_Year" & n_LigneCb & "_DropButtonClick()" & vbCrLf
str_CodeCByear = str_CodeCByear & "Dim i As Integer" & vbCrLf
str_CodeCByear = str_CodeCByear & "fm_Payment.cb_Year" & n_LigneCb & ".Clear" & vbCrLf
str_CodeCByear = str_CodeCByear & "For i = 1 To " & n_Annee & vbCrLf
str_CodeCByear = str_CodeCByear & "fm_Payment.cb_Year" & n_LigneCb & ".AddItem (sh_Data.Cells(i, 5))" & vbCrLf
str_CodeCByear = str_CodeCByear & "Next i" & vbCrLf
str_CodeCByear = str_CodeCByear & "End Sub"
 
str_CodeCBday = "Private Sub cb_Month" & n_LigneCb & "_Change()" & vbCrLf
str_CodeCBday = str_CodeCBday & "Dim i As Integer" & vbCrLf
str_CodeCBday = str_CodeCBday & "n_LigneJour = sh_Data.Cells(WorksheetFunction.Match(fm_Payment.cb_Month" & n_LigneCb & ".Value, sh_Data.Columns(3), 0), 4).Value" & vbCrLf
str_CodeCBday = str_CodeCBday & "fm_Payment.cb_Day" & n_LigneCb & ".Clear" & vbCrLf
str_CodeCBday = str_CodeCBday & "For i = 1 To n_LigneJour" & vbCrLf
str_CodeCBday = str_CodeCBday & "fm_Payment.cb_Day" & n_LigneCb & ".AddItem (sh_Data.Cells(i, 4))" & vbCrLf
str_CodeCBday = str_CodeCBday & "Next i" & vbCrLf
str_CodeCBday = str_CodeCBday & "End Sub"
 
With ThisWorkbook.VBProject.VBComponents("fm_Payment").codemodule
    n_x = .countoflines + 1
    .InsertLines n_x, str_CodeCBmonth
    .InsertLines n_x + 8, str_CodeCByear
    .InsertLines n_x + 16, str_CodeCBday
End With
 
End Sub

j'ai bien mis dans un module de classe le code suivant:

Code:

1
2
3
4
5
6
7
8
Option Explicit
Public WithEvents CbBx As MSForms.ComboBox
 
Private Sub CbBx_DropButtonClick()
 
'==========> doit on definir quelque chose ici?? j'ai l'impression que oui mais je ne sais pas trop comment l'utiliser
 
End Sub

et enfin le code que cela insere quand je clique sur le boutton:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub cb_Month2_DropButtonClick()
Dim i As Integer
fm_Payment.cb_Month2.Clear
For i = 1 To 12
fm_Payment.cb_Month2.AddItem (sh_Data.Cells(i, 3))
Next i
End Sub
Private Sub cb_Year2_DropButtonClick()
Dim i As Integer
fm_Payment.cb_Year2.Clear
For i = 1 To 3
fm_Payment.cb_Year2.AddItem (sh_Data.Cells(i, 5))
Next i
End Sub
Private Sub cb_Month2_Change()
Dim i As Integer
n_LigneJour = sh_Data.Cells(WorksheetFunction.Match(fm_Payment.cb_Month2.Value, sh_Data.Columns(3), 0), 4).Value
fm_Payment.cb_Day2.Clear
For i = 1 To n_LigneJour
fm_Payment.cb_Day2.AddItem (sh_Data.Cells(i, 4))
Next i
End Sub

Merci pour votre, aide!
Si le probleme n'est pas assez bien explique, dites le moi, j'essaierai de faire au mieux pour reexpliquer

Bon j'ai un peu avance et j'ai trouve!!! :)
EN fait j'ai supprime le code qui servait a inserer un nouveau code au cours de la macro qui etait le suivant:

Code:

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
str_CodeCBmonth = "Private Sub cb_Month" & n_LigneCb & "_DropButtonClick()" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "Dim i As Integer" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "fm_Payment.cb_Month" & n_LigneCb & ".Clear" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "For i = 1 To " & n_Mois & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "fm_Payment.cb_Month" & n_LigneCb & ".AddItem (sh_Data.Cells(i, 3))" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "Next i" & vbCrLf
str_CodeCBmonth = str_CodeCBmonth & "End Sub"
 
str_CodeCByear = "Private Sub cb_Year" & n_LigneCb & "_DropButtonClick()" & vbCrLf
str_CodeCByear = str_CodeCByear & "Dim i As Integer" & vbCrLf
str_CodeCByear = str_CodeCByear & "fm_Payment.cb_Year" & n_LigneCb & ".Clear" & vbCrLf
str_CodeCByear = str_CodeCByear & "For i = 1 To " & n_Annee & vbCrLf
str_CodeCByear = str_CodeCByear & "fm_Payment.cb_Year" & n_LigneCb & ".AddItem (sh_Data.Cells(i, 5))" & vbCrLf
str_CodeCByear = str_CodeCByear & "Next i" & vbCrLf
str_CodeCByear = str_CodeCByear & "End Sub"
 
str_CodeCBday = "Private Sub cb_Month" & n_LigneCb & "_Change()" & vbCrLf
str_CodeCBday = str_CodeCBday & "Dim i As Integer" & vbCrLf
str_CodeCBday = str_CodeCBday & "n_LigneJour = sh_Data.Cells(WorksheetFunction.Match(fm_Payment.cb_Month" & n_LigneCb & ".Value, sh_Data.Columns(3), 0), 4).Value" & vbCrLf
str_CodeCBday = str_CodeCBday & "fm_Payment.cb_Day" & n_LigneCb & ".Clear" & vbCrLf
str_CodeCBday = str_CodeCBday & "For i = 1 To n_LigneJour" & vbCrLf
str_CodeCBday = str_CodeCBday & "fm_Payment.cb_Day" & n_LigneCb & ".AddItem (sh_Data.Cells(i, 4))" & vbCrLf
str_CodeCBday = str_CodeCBday & "Next i" & vbCrLf
str_CodeCBday = str_CodeCBday & "End Sub"
 
With ThisWorkbook.VBProject.VBComponents("fm_Payment").codemodule
    n_x = .countoflines + 1
    .InsertLines n_x, str_CodeCBmonth
    .InsertLines n_x + 8, str_CodeCByear
    .InsertLines n_x + 16, str_CodeCBday
End With

et j'ai modifie mon code dans mon module de classe, enfin j'en ai rajoute, par le code suivant:

Code:

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
Public WithEvents CbBx As MSForms.ComboBox
 
Private Sub CbBx_DropButtonClick()
Dim i As Integer, str_x As String, ctr_x As Control
 
str_x = Left(CbBx.Name, 4)
 
Select Case str_x
    Case Is = "cb_M"
        'CbBx.Clear
        For i = 1 To 12
            CbBx.AddItem (sh_Data.Cells(i, 3))
        Next i
    Case Is = "cb_D"
        For Each ctr_x In fm_Payment.Controls
            If ctr_x.Name = "cb_Month" & n_LigneCb Then
                'CbBx.Clear
                n_LigneJour = sh_Data.Cells(WorksheetFunction.Match(ctr_x.Value, sh_Data.Columns(3), 0), 4).Value
                For i = 1 To n_LigneJour
                    CbBx.AddItem (i)
                Next i
            Else
            End If
        Next ctr_x
    Case Is = "cb_Y"
        'CbBx.Clear
        For i = 1 To 3
            CbBx.AddItem (sh_Data.Cells(i, 5))
        Next i
    Case Else
 
End Select
 
 
End Sub