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

Résolu

Ant716 Messages postés 7 Date d'inscription Statut Membre Dernière intervention -
Ant716 Messages postés 7 Date d'inscription Statut Membre Dernière intervention - 12 juin 2020 à 13:36

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 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

Afficher la suite

A voir également:

UserForm ce ferme avant de sortir de la macro...
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Rouvrir onglet fermé chrome - Guide
Application se ferme toute seule android - Guide
Avant browser - Télécharger - Navigateurs
Coco.fr fermé - Accueil - Réseaux sociaux

6 réponses

Réponse 1 / 6

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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/

Réponse 2 / 6

Ant716 Messages postés 7 Date d'inscription Statut Membre Dernière intervention

Bonjour,

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

Cordialement
Antoine

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,
chez moi bloque ici!

Sub InitializeUserFormSubCat()
    Unload UserForm_SubFilter

Ant716 Messages postés 7 Date d'inscription Statut Membre Dernière intervention > f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention

Retire cette ligne elle me serre a décharger le userform quand je doit l'appeler plusieurs fois de suite.
Donc remplace par:

'Unload UserForm_SubFilter

J'ai mis a jours le 1er post.

Cordialement, antoine

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > Ant716 Messages postés 7 Date d'inscription Statut Membre Dernière intervention

Re,
Toujours pas bon, pas possible d'entrer en mode arret 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

Réponse 3 / 6

Ant716 Messages postés 7 Date d'inscription Statut Membre Dernière intervention

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?

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

Excel 2013.
la ca plante aussi ici:
Pas chez moi, reecrit autant de fois que click bouton
Mais pas d'apparition de l'uf!

Suite:

pourquoi en mode arrêt ça plante?
A lire:
https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/can-t-enter-break-mode-at-this-time

Réponse 4 / 6

Ant716 Messages postés 7 Date d'inscription Statut Membre Dernière intervention

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?

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,
En partant du code de ce lien:
https://www.developpez.net/forums/d1151084/logiciels/microsoft-office/excel/macros-vba-excel/userform-dynamique/#post6337599

fichier modifie avec creation et destruction UF en dynamique (plus simple, pas de delete de quoi que ce soit)
https://mon-partage.fr/f/27nfMFvd/

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 6

Ant716 Messages postés 7 Date d'inscription Statut Membre Dernière intervention

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...
??

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

créer les macro dans un module
Les procedures sont propres a l'UF, pourquoi un module?

Réponse 6 / 6

Ant716 Messages postés 7 Date d'inscription Statut Membre Dernière intervention

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

Discussions similaires

je voudrais accéder à mon compte copains d'avant

Copains d'avant, qui a visité notre profil

Perte de mes anciens accès pour Copain D'Avant

recupération compte copain

Comment savoir qui a visité notre profil copain d'avant et facebook ?

Votre réponse

Discussions similaires