Antoine716
XLDnaute Nouveau
Bonjour a tous,
Voila plusieurs heures que je cherche sans succès une réponse a mon problème!
Je travail avec des macro qui initialise est ouvre un UserForm.
Sur la feuille 1, j'ai un bouton "Initi" qui lance la macro.
Dans la macros je créer des bouton dynamiquement suivant les paramètre de la feuille 2.
Ca marche très bien! (En mode non modale)
La ou ça coince c'est quand je veux ajouter une macro a chaque ToggleButton créer.
J'utilise donc : ThisWorkbook.VBProject.VBComponents() pour ajouter des macro dans le userform.
Ca marche également mais a la fin de la macro tout mon UserForm ce ferme!
(Il s'ouvre et ce ferme en une fraction de seconde!)
Je doit mettre mon userForm en mode Modale si je veut que ça reste affiché a l'ecran!
Si quelqu'un peut m'aidez!
merci d'avance,
Cordialement antoine.
Voila plusieurs heures que je cherche sans succès une réponse a mon problème!
Je travail avec des macro qui initialise est ouvre un UserForm.
Sur la feuille 1, j'ai un bouton "Initi" qui lance la macro.
Dans la macros je créer des bouton dynamiquement suivant les paramètre de la feuille 2.
Ca marche très bien! (En mode non modale)
La ou ça coince c'est quand je veux ajouter une macro a chaque ToggleButton créer.
J'utilise donc : ThisWorkbook.VBProject.VBComponents() pour ajouter des macro dans le userform.
Ca marche également mais a la fin de la macro tout mon UserForm ce ferme!
(Il s'ouvre et ce ferme en une fraction de seconde!)
Je doit mettre mon userForm en mode Modale si je veut que ça reste affiché a l'ecran!
Si quelqu'un peut m'aidez!
merci d'avance,
Cordialement antoine.
VB:
Private Sub Delete_Code_ThisModule()
With ActiveWorkbook.VBProject.VBComponents("UserForm_SubFilter").CodeModule
.DeleteLines 1, .CountOfLines
'.CodePane.Window.Close
End With
End Sub
Sub InitializeUserFormSubCat()
Dim Module As Object
Unload UserForm_SubFilter
Delete_Code_ThisModule
Set Module = ThisWorkbook.VBProject.VBComponents("UserForm_SubFilter")
'If Err.Number <> 0 Then: Set Module = ThisWorkbook.VBProject.VBComponents.Add(1)
Dim Bouton As Object
Dim nLabel As Object
LargeurBouton = 70
HauteurBouton = 20
Dim shB As Worksheet
Set shB = ThisWorkbook.Worksheets("Feuil2")
nFilter = 1
nCheckFilter = 1
nToggleButton = 1
iBuff = 0
Do While Not (IsEmpty(shB.Cells(4, nCheckFilter)))
i = 0
If Not (IsEmpty(shB.Cells(6, nCheckFilter))) Then
UserForm_SubFilter.Width = 25 + ((LargeurBouton + 5) * nFilter)
Set nLabel = UserForm_SubFilter.Controls.Add("Forms.Label.1")
With nLabel
.Caption = shB.Cells(4, nCheckFilter)
.Font.Bold = True
.Font.Size = 10
.Height = 15
.Width = LargeurBouton
.Left = 10 + (LargeurBouton + 5) * (nFilter - 1)
.Top = 3
End With
End If
Do While Not (IsEmpty(shB.Cells(i + 6, nCheckFilter)))
nameToggleButton = "ToggleButtonSubFilter" & nToggleButton & "_Click()"
captionToggleButton = shB.Cells(i + 6, nCheckFilter)
Set Bouton = UserForm_SubFilter.Controls.Add("Forms.ToggleButton.1")
With Bouton
.Name = nameToggleButton
.Caption = captionToggleButton
.BackColor = &H808000
.ForeColor = &HFFFFFF
.Font.Bold = True
.Font.Size = 8
.Height = HauteurBouton
.Width = LargeurBouton
.Left = 5 + (LargeurBouton + 5) * (nFilter - 1)
.Top = (HauteurBouton + 2) * (i + 1)
End With
With Module.CodeModule
.InsertLines .CountOfLines + 1, "Private Sub " & nameToggleButton
.InsertLines .CountOfLines + 1, " Test(" & captionToggleButton & ")"
.InsertLines .CountOfLines + 1, "End Sub"
.InsertLines .CountOfLines + 1, ""
End With
i = i + 1
nToggleButton = nToggleButton + 1
Loop
If i > iBuff Then
iBuff = i
End If
UserForm_SubFilter.Height = 50 + ((HauteurBouton + 2) * (iBuff))
nFilter = nFilter + 1
nCheckFilter = nCheckFilter + 1
Loop
UserForm_SubFilter.Show
End Sub
Dernière édition:
