XL 2016 VBA - Lister les UserForms du Projet VBA

[Dudu2]

Bonjour,

Je n'obtiens aucun résultat avec ce code:

Sub a()
    Dim Usf As Object
    Dim k As Integer
    
    For Each Usf In VBA.UserForms
        k = k + 1
        MsgBox k & " " & Usf.Name
    Next Usf
End Sub

Auriez-vous une solution ?
Merci par avance.

 

[yal]

Bonjour
Peut-être comme ça

Sub b()
  Dim obj As Object
  Dim k%
  For Each obj In ThisWorkbook.VBProject.VBComponents
    If obj.Type = 3 Then
      k = k + 1
      MsgBox k & " " & obj.Name
    End If
  Next obj
End Sub

 

[Dudu2]

Merci @yal

Maintenant j'aimerais valoriser une variable Objet d'un UserForm dont je connais le nom.
Mais étrange et pas bon...

Sub b()
    Dim Usf As Object
 
    Set Usf = Application.VBE.ActiveVBProject.vbcomponents("UserForm1").designer
    MsgBox "Usf est un UserForm ? " & TypeOf Usf Is UserForm
    MsgBox "Usf.Visible = " & Usf.Visible
End Sub

Alors vous me direz pourquoi simplement pas Set Usf = UserForm1 ?
C'est que j'ai plusieurs versions du code et dans certaines UserForm1 n'y est pas et je ne veux pas changer la séquence (le module de classe) dans laquelle on y fait référence.

 

[patricktoulon]

re parce qu'avant tout userform1 est un module (classe"userform") et non un object userform
tu saisi la nuance ?
et en plus de ça tu fait un set sur un ".designer"

 

[Dudu2]

Oui je sais c'est du tâtonnement. Ça n'a pas de sens logique.
Je vais régler mon problème en insérant des UserForms bidon dans les versions de code qui n'utilisent pas réellement les UserForms. Je ne pense pas que ce que je voudrais faire soit possible.

 

[Dudu2]

La seule chose qui serait utilisable c'est ça:

Sub b()
    Dim Usf As Object
    Const UsfName = "UserForm1"
  
    Load UserForm1
    Load UserForm2
  
    For Each Usf In VBA.UserForms
        If Usf.Name = UsfName Then Exit For
    Next Usf

    If Not Usf Is Nothing Then
        MsgBox "Usf est un UserForm ? " & TypeOf Usf Is UserForm
        MsgBox "Usf.Visible = " & Usf.Visible
    Else
        MsgBox UsfName & " non trouvé"
    End If
  
    Unload UserForm1
    Unload UserForm2
End Sub

Mais ça ne marche que si les UserForms sont chargés. Donc inutile pour ce que je veux faire.

 

[patricktoulon]

mais non!!....
voilà comment on fait pour partir du vbcomponent vers l'object userform

Sub b()
    Dim Usf As Object

    Set Usf = Application.VBE.ActiveVBProject.vbcomponents("UserForm1")
    MsgBox TypeName(Usf)

    
    VBA.UserForms.Add (Usf.Name)    'on l'ajoute a la collection forms de vba  si l'on veux l'object!!!!! userform!!!!
    'ben maintenant c'est facile
    'on vient de l'ajouter  à  la collection ,c'est donc le dernier
    Set Usf = UserForms(UserForms.Count - 1)'et oui c'est en base 0

    MsgBox TypeName(Usf)

    
End Sub

voilà

designer on s'en sert pour ajouter des controls définitivement (en dur)

 

[Dranreb]

Les UserForm affichés ne sont pas de type UserForm mais du nom de type dedéfini par l'utilisateur qui est le nom de sa définition dans la rubrique Feuilles du projet VBA.
UserForm est essentiellement le nom d'un générateur d'évènements interne à tous les objets personnalisés construits par Insertion, UserForm, lesquels n'en sont pas, en somme, mais seulement des dérivés personnalisés.

 

[Dudu2]

@patricktoulon, merci pour la conversion. Cette notion d'ajout à la collection m'échappe un peu mais je constate que ça marche. Je suppose qu'un Load l'ajoute à la collection et que tous ceux qui sont ouverts populent cette collection d'où la recherche du dernier ?

@Dranreb, merci pour cette définition. J'avais bien remarqué que UserForm1 était bien un type mais j'étais loin de faire cette distinction.

Merci encore les experts !

 

[Hasco]

Bonjour,

Voici dans le fichier ci_joint une fonction que j'avais écrite en 2007 pour un client. En l'associant à votre fonction légèrement pour qu'elle indique seulement si un userform nommé x existe dans le projet, vous pourrez peut-être faire quelque chose.

Il y a deux module avec deux exemples et 3 userform

Function usfStatus(strUsfName As String) As Byte
'---------------------------------------------------------------------
' Auteur     : hasco 14/03/2007 modifiée le 16/10/2022 pour xld
' Fonction  : retourne un byte indiquant le status d'un userform
'                 : 0 = non chargé  2 = chargé 4 = chargé et visible
'----------------------------------------------------------------------
    Dim i As Integer
    usfStatus = 0
    For i = 0 To UserForms.Count - 1
        If LCase(UserForms(i).Name) = LCase(strUsfName) Then
            usfStatus = 2 + (UserForms(i).Visible * -2)
            Exit For
        End If
    Next i

Cordialement

 

[Dudu2]

@patricktoulon,
Question subsidiaire... Si on l'ajoute à la collection et qu'il y est déjà, pas de dommages collatéraux ?

@Hasco, merci, je vais regarder.

 

[patricktoulon]

re
non le fait de faire un add a la collection deplace l'existant a la fin de la liste
le mode designer ce n'est que pour le mode edition par vba (donc en écriture seulement)

 

[patricktoulon]

@Hasco bonjour
jolie le retour de 3 position en une seule opération
usfStatus = 2 + (UserForms(i).Visible * -2)

 

[Dudu2]

le mode designer ce n'est que pour le mode edition par vba (donc en écriture seulement)

Oui, ça je m'en doutais Designer -> Mode Création. Mais j'étais intéressé à tout hasard par le TypOf retourné qui était UserForm, et donc pas le bon type suite aux explications de @Dranreb et de @patricktoulon.

jolie le retour de 3 position en une seule opération

Et oui @Hasco que je remercie pour ses fonctions, faisait déjà en 2007 (je n'étais alors qu'un jeunot de 54 ans), des opérations complexes pour ses clients.

 

[patricktoulon]

tiens @Dudu2 si ca peut t'éclairer sur le vbcomponent / useforms/userform/properties/designer
un vieux truc que j'ai fait y a des années de ça
mes premieres boites de dialog dynamico autodestructible
exemple ici un msgbox perso
ne m'en veux pas ce code a plus de 15 ans
rien n'existe avant / rien n'existe après

Option Explicit
Sub test()
    MsgBox "vous avez cliqué sur " & msg("salut Dudu2")
End Sub
Function msg(texte)
    Dim Obj As Object, usf
    Dim j As Integer
    Set usf = ThisWorkbook.VBProject.VBComponents.Add(3)
    With usf: .Properties("Caption") = "msgboxAA": .Properties("Width") = 250: .Properties("Height") = 150: End With

    Set Obj = usf.Designer.Controls.Add("forms.TextBox.1", "content")
    With Obj:
        .Left = 0:
        .Top = 0:
        .Width = usf.Properties("InsideWidth"):
        .Height = usf.Properties("Insideheight") - 25
        .Name = "content":
        .BackColor = &H80C0FF:
        .ForeColor = vbGreen
        .Font.Name = "algerian"
        .Font.Size = 16
        .TextAlign = 2
        .MultiLine = True
        'et toutes autre propriété des textboxs font,borderstyle,etc......
        .Value = texte


    End With
    Set Obj = usf.Designer.Controls.Add("forms.CommandButton.1", "boutonOK")
    With Obj:
        .Left = usf.Properties("Width") - 60
        .Top = usf.Properties("Height") - 25 - 20
        .Width = 50
        .Height = 20
        .Name = "bouttonOK":
        .BackColor = vbRed
        .ForeColor = vbGreen
        .Caption = "OK"
    End With

    Set Obj = usf.Designer.Controls.Add("forms.CommandButton.1", "boutoncancel")
    With Obj:
        .Left = usf.Properties("Width") - 120
        .Top = usf.Properties("Height") - 25 - 20
        .Width = 50
        .Height = 20
        .Name = "boutoncancel":
        .BackColor = vbBlue
        .ForeColor = vbMagenta
        .Caption = "ANNULER"
    End With


    'creation insertion code du des evenements
    With usf.CodeModule
        j = .CountOfLines
        .insertlines j + 1, "public reponse"
        .insertlines j + 2, "Private Sub bouttonOK_Click():reponse = ""ok"": Me.Hide:End Sub"
        .insertlines j + 3, "Private Sub boutoncancel_Click():reponse = ""Annuler"":me.hide:End Sub"
        .insertlines j + 4, "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)"
        .insertlines j + 5, "If CloseMode = 0 Then Cancel = True: Me.Hide"
        .insertlines j + 6, "End Sub"


    End With
    VBA.UserForms.Add (usf.Name)
    'affichage du pseudo msgbox
    With UserForms(UserForms.Count - 1)
        .Show
        msg = .reponse
    End With
    ThisWorkbook.VBProject.VBComponents.Remove (usf)
End Function

purée j'ai retrouvé des pépites