XL 2010 UserForm ce ferme avant de sortir de la macro

Antoine716 · 9 Juin 2020

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.

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

Antoine716 · 10 Juin 2020

Bonjour,
Je me permet de relancer!

Help me....

Antoine

bof · 10 Juin 2020

Bonjour,
Hum... juste pour amorcer le débat hein ! Je ne sais pas finaliser ton truc parce que je n'ai pas trop compris la finalité... Mébon, je te donne ce qu'il en reste avec ma façon de voir les choses parce que ton code m'a vraiment pas inspiré !
Je pense qu'il se trouvera surement un dégourdi pour finaliser en fonction de tes explications...
A+

Antoine716 · 11 Juin 2020

Salut,

Ta solution marche très bien! Même en mode non modale.
Je vais arranger ça a ma sauce en espérant que tout roule!

Merci a toi.

Antoine716 · 12 Juin 2020

Bonjour,

Alors après quelques test, est une erreur récurrente j'ai trouvée d'ou venez le souci:
Si une colonne de la feuille 2 ne comporte qu'une seul case, ca plante la macro est m'affiche un message du type "Erreur 6 ......... Débordement......"
J'ai noté la ligne qui plante, c'est a l'entré de la boucle For :

VB:

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

Merci d'avance
Cordialement
antoine

bof · 12 Juin 2020

Remplacer cette ligne :

VB:

iRow = ShB.Cells(6, i).End(xlDown).Row ' par
iRow = shB.Cells(9 ^ 2, i).End(xlUp).Row

A+

Antoine716 · 12 Juin 2020

Peut tu m'expliquer?
9 puissance 2? a la place de 6?

bof · 12 Juin 2020

C'est pas 9^2 à la place de 6 : Ç'est toute la ligne qu'il faut changer...

9^2 en VBA/Excel ça se lit 9 puissance 2

A l'origine la ligne "End(xlDown)" était censé délimiter la dernière ligne de la zone. Sauf que xlDown renvoie une erreur si la première ligne est aussi la dernière.
Donc je suis parti de plus bas (9^2 = 81] "End(xlUp)" pour déterminer cette dernière ligne.
En supposant que tu n'aurais pas plus de 75 boutons dans la même colonne... sinon on pourrait mettre 9^3 et ça permettrait plus de 720 boutons...

En général j'utilise cette notation pour signifier un "grand nombre" sans rechercher vraiment de précision...

A+

Antoine716 · 12 Juin 2020

bof à dit:
C'est pas 9^2 à la place de 6 : Ç'est toute la ligne qu'il faut changer...

9^2 en VBA/Excel ça se lit 9 puissance 2

A l'origine la ligne "End(xlDown)" était censé délimiter la dernière ligne de la zone. Sauf que xlDown renvoie une erreur si la première ligne est aussi la dernière.
Donc je suis parti de plus bas (9^2 = 81] "End(xlUp)" pour déterminer cette dernière ligne.
En supposant que tu n'aurais pas plus de 75 boutons dans la même colonne... sinon on pourrait mettre 9^3 et ça permettrait plus de 720 boutons...

En général j'utilise cette notation pour signifier un "grand nombre" sans rechercher vraiment de précision...

A+

Merci beaucoup pour tes précision,
J'avais bien changé toute la ligne, est j'ai répondu trop vite, j'ai vue xlUp après......

Je code habituellement en C et C++, j'ai du mal avec les terme du VBA.

Dernière question:
Ce code n'est qu'un morceau du code entier, dans la version complète, ce UserForm est un sous filtre de sélection.
Il y a donc un UserForm principale avec le filtre de sélection principale qui correspond a la ligne 4 de la feuil 2.
Il y a donc plus ou moins de "Non" sélectionné que je range du un Variant puis que j'envoie a ce UserForm sous filtre. ensuite je créer les bouton en fonction des seul nom présents dans le variant.

Du coup ce userform doit ce mettre a jour quand le filtre principale change, et si possible que les bouton cliqué le reste....
Une idées pour ca?

est oui dans ton code, a quoi sert cette fonction?

VB:

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Erase Boutons_Cdes
Unload Me
End Sub

Merci pour ton aide.

bof · 12 Juin 2020

A réinitialiser la classe "Boutons_Cdes)"
Comme tu n'as pas de bouton de fermeture on peut supposer que tu vas fermer le userForm avec la croix de fermeture...
Si tu ne réinitialises pas, lors de la prochaine ouverture la classe va continuer d'incrémenter des boutons supplémentaires. (donc de les numéroter de manière aberrante)
A+

Antoine716 · 12 Juin 2020

Ok merci pour cette précision.

J'ai testé ceci, j'ouvre le Uf, ensuite je vais modifié la feuil 2 , si je réinitialise le uf, le userform reste inchangé....
Comment je fait pour qu'il ce remette a jour?
J'ai essayé de le fermer mais ca marche pas.

Merci

bof · 13 Juin 2020

Modifie la feuille 2 et ouvre ton UserForm : Ça marche ?
C'est ce que tu fais après qui ne marche pas !

Si tu réinitialises le UserForm il faut réinitialiser la classe également (c. a d. fermer le UserForm)

EDIT : Si ça ne t'enchante pas (fermer le UserForm), Je ne vois qu'une solution :
1 - Générer tous les boutons pour qu'ils soient tous présents dans la classe.
2 - en fonction de ton filtre donner une propriété invisible ou pas aux boutons .
3 - pour chaque groupe (colonne) donner un tag (incrémenté) aux boutons qui doivent rester visibles
En fonction du tag calculer la position Top de chaque bouton pour l'affichage.

Quand ton filtre va changer tu vas remettre tous les boutons invisibles, et sans Tag puis rendre visible et taguer à nouveau. Le calcul de la position Top ne changera pas lui puisque c'est en fonction du Tag...

C'est chaud hein !

Avantage : Pas besoin de réinitialiser le Userform puis que tu ne changes que quelques propriétés. Tu as juste une petite Private Sub MAJ() à pondre...

A+

Antoine716 · 15 Juin 2020

Salut,

Ok je vois..... Bon je vais certainement opter pour une fermeture et une réouverture du Uf.
Mais il me semble que .hide cache la fenêtre seulement?
Donc je doit également tester en entré de macro si mon uf Forme existe déjà, et si oui, le fermer et le ré ouvrir?

bof · 15 Juin 2020

Là comme ça je peux pas te dire : c'est toi qui voit. Mais normalement YAPA de raison
Si tu fais

VB:

Unload Me
Show ' C'est qu'il est forcément fermé !

Mébon, je maîtrise pas la totalité de ton code...

XL 2010 UserForm ce ferme avant de sortir de la macro

Antoine716

XLDnaute Nouveau

Pièces jointes

Antoine716

XLDnaute Nouveau

bof

XLDnaute Occasionnel

Pièces jointes

Antoine716

XLDnaute Nouveau

Antoine716

XLDnaute Nouveau

bof

XLDnaute Occasionnel

Antoine716

XLDnaute Nouveau

bof

XLDnaute Occasionnel

Antoine716

XLDnaute Nouveau

bof

XLDnaute Occasionnel

Antoine716

XLDnaute Nouveau

bof

XLDnaute Occasionnel

Antoine716

XLDnaute Nouveau

bof

XLDnaute Occasionnel

Discussions similaires