UserForm ce ferme avant de sortir de la macro... Résolu

Question

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.

Voici le code:
Private Sub Delete_Code_ThisModule()     With ActiveWorkbook.VBProject.VBComponents("UserForm_SubFilter").CodeModule        .DeleteLines 1, .CountOfLines        '.CodePane.Window.Close    End With End SubSub 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.ShowEnd Sub

f894009 · Answer

Bonjour,

Pouvez mettre votre fichier a dispo?

Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com

Allez sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...

ou
'mon partage
https://mon-partage.fr/

Ant716 · Answer

Bonjour,

Merci pour votre réponse, voici le liens du fichiers:
https://www.cjoint.com/c/JFkjM7rStZs

Cordialement
Antoine

Ant716 · Answer

Je bosse sur Excel 2010, a mon post ca marche quand j'appuie sur le Bouton Init de la feuille 1.
Mais si je lance la macro pas a pas en mode arrêt ca plante ici:
Delete_Code_ThisModule

Si je met cette ligne en commentaire, la ca plante aussi ici:
With Module.CodeModule

.InsertLines .CountOfLines + 1, "Private Sub " & nameToggleButton
                    .InsertLines .CountOfLines + 1, "   Test(" & captionToggleButton & ")"
                    .InsertLines .CountOfLines + 1, "End Sub"
                    .InsertLines .CountOfLines + 1, ""

End With

Quel version d'excel utilise tu? 

Justement je cherche a savoir pourquoi en mode arrêt ça plante?

Ant716 · Answer

Voici un nouveau fichier:
https://www.cjoint.com/c/JFko1xonfus

Pour que tu vois le UserForm.

Mais comment ajouter une macro dynamiquement a chaque bouton?

Ant716 · Answer

Salut, 

Alors la création du UserForm c'est Top est plus propre.
Ta solution marche mais en mode Modale, en Non modale j'ai exactement le même problème qu'avant.

J'ai donc ajouter ceci au propriété du UserForm:
Set UsfForm = ThisWorkbook.VBProject.VBComponents.Add(3)
    With UsfForm
        .Properties("Caption") = "Sous catégories"
        .Properties("ShowModal") = False
    End With
    UsfName = UsfForm.Name

Et enlevé ceci a la fin:
VBA.UserForms.Add(UsfName).Show
    'ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=UsfForm

Je pense qu'il serai judicieux de relever les information de la feuille2, les stocker dans des Variant, ensuite créer les macro dans un module et enfin créer le userform...
??

Ant716 · Answer

Bonjour,

J'avais également poster le souci sur un autre forum, voici la solution:
Module Main:
Public Boutons_Cdes() As New Classe1

Sub ShowUsf()
   usfTest.Show 0
End Sub

Sub Action(i$)
   MsgBox "Vous avez cliqué " & i
End Sub


Module de classe:
Option Explicit

Public WithEvents BoutonCde As MSForms.ToggleButton
Private Sub BoutonCde_Click()
Dim i$
   i = BoutonCde.Caption
   Action i
End Sub


Userform
Option Explicit

Private Sub UserForm_Initialize()
Dim Larg&, Haut&, i%, iColumn%, iRow%, k%, ii%, iMem
Dim Obj As Control

For Each Obj In usfTest.Controls
    If Left(Obj.Name, 2) = "tb" Then usfTest.Controls.Remove Obj.Name
Next

Larg = 70
   Haut = 20
   iColumn = ShB.Cells(4, 1).End(xlToRight).Column
   
   For i = 1 To iColumn
          Set Obj = usfTest.Controls.Add("Forms.Label.1")
          With Obj
              .Caption = ShB.Cells(4, i)
               With .Font
                .Bold = True
                .Size = 10
               End With
              .Height = 15
              .Width = Larg
              .Left = 10 + (Larg + 5) * (i - 1)
              .Top = 3
          End With
    Next
    
    For i = 1 To iColumn
      If ShB.Cells(6, i) <> "" Then 'Si la celulle n'est pas vide
      
      On Error Resume Next
        ii = UBound(Boutons_Cdes)
      On Error GoTo 0
      
      'iMem = iRow - 5
      'iRow = ShB.Cells(6, i).End(xlDown).Row
      iRow = ShB.Cells(9 ^ 2, i).End(xlUp).Row
      If iRow - 5 > iMem Then
        iMem = iRow - 5
      End If
      
         For k = 1 To iRow - 5
            Set Obj = Me.Controls.Add("forms.ToggleButton.1")
               With Obj
                   .Name = "tb" & k + ii
                   .Caption = ShB.Cells(k + 5, i)
                   .BackColor = &H808000
                   .ForeColor = &HFFFFFF
                    With Font
                        .Bold = True
                        .Size = 8
                    End With
                   .Height = Haut
                   .Width = Larg
                   .Left = 5 + (Larg + 5) * (i - 1)
                   .Top = (Haut + 2) * (k)
               End With
            ReDim Preserve Boutons_Cdes(1 To k + ii)
            Set Boutons_Cdes(k + ii).BoutonCde = Obj
         Next
      End If
      Next
Set Obj = Nothing
      usfTest.Height = 55 + ((Haut + 2) * iMem)
      usfTest.Width = 25 + ((Larg + 5) * iColumn)
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Erase Boutons_Cdes
Unload Me
End Sub

Si cela peut aider quelqu'un d'autre....

Merci beaucoup pour l'aide,

Bien cordialement

UserForm ce ferme avant de sortir de la macro...

6 réponses

Discussions similaires

Newsletters