XL 2016 VBA - Lister les UserForms du Projet VBA

Dudu2

XLDnaute Barbatruc
Bonjour,

Je n'obtiens aucun résultat avec ce code:
VB:
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.
 

Pièces jointes

  • Classeur1.xlsm
    24.3 KB · Affichages: 4

Dudu2

XLDnaute Barbatruc
Merci @yal

Maintenant j'aimerais valoriser une variable Objet d'un UserForm dont je connais le nom.
Mais étrange et pas bon...
VB:
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.
 

Pièces jointes

  • Classeur1.xlsm
    27.8 KB · Affichages: 2
Dernière édition:

Dudu2

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

XLDnaute Barbatruc
La seule chose qui serait utilisable c'est ça:
VB:
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.
 

Pièces jointes

  • Classeur1.xlsm
    28.6 KB · Affichages: 1

patricktoulon

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

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

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

XLDnaute Barbatruc
@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

XLDnaute Barbatruc
Repose en paix
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
VB:
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
 

Pièces jointes

  • UserForms pour Dudu2.xlsm
    33.8 KB · Affichages: 4

Dudu2

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

XLDnaute Barbatruc
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
VB:
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
 

Discussions similaires

Réponses
4
Affichages
404

Membres actuellement en ligne

Statistiques des forums

Discussions
314 499
Messages
2 110 249
Membres
110 711
dernier inscrit
chmessi