IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Comment réunir UserForm et Module de classe en un seul module exportable?


Sujet :

Macros et VBA Excel

  1. #21
    Membre émérite
    Avatar de pijaku
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    1 814
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : Août 2010
    Messages : 1 814
    Points : 2 948
    Points
    2 948
    Billets dans le blog
    10
    Par défaut
    @Pierre Fauconnier :
    Le cancel, je ne l'ai pas mis sur le code du bouton btnCancel mais sur l'événement QueryClose de l'UserForm. Cela fonctionne plutôt pas mal.

    Pour le reste, ce sont des pratiques qui, respectées, me permet de coder "le plus proprement possible"... A chacun son style...
    Disons que je teste le mien...de style

    @rdurupt :
    Merci de ta contribution.
    Mais pourrais tu développer un peu stp?
    L'idée ici est de fournir un objet à un utilisateur novice, objet qui :
    - doit pouvoir comporter un nombre dynamique de contrôles,
    - ces contrôles doivent réagir (au clic ou à tout autre événement)
    - l'utilisation par le "novice" se doit d'être toute simple (une ou deux lignes dans le code appelant)
    J'ai essayé ton code. Effectivement l'userform est bien là, il est bien détruit à la fin mais le reste n'est pas là.
    Merci d'avance pour tes explications.
    Cordialement,
    Franck

  2. #22
    Invité
    Invité(e)
    Par défaut
    bien évidement, il est possible de tout placer dans le module de classe et de ne laisser que Usf.Show dans le sub test
    Code Module de classe : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    #If VBA7 Then
        Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare PtrSafe  Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
        Private Declare PtrSafe  Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
        Private Declare  PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     #Else
        Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
        Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
        Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    #End If
    Private Const SC_CLOSE = &HF060&
    Private Const MF_BYCOMMAND = &H0&
     Dim hwnd As Long, Style As Long
    Public Usf As Object
    Private Nom As String
    Private Dico As Object
     
    Public WithEvents Bouton As MSForms.CommandButton
    'Initialise la collection
    Private Sub Class_Initialize()
     Set Dico = CreateObject("Scripting.dictionary")
    End Sub
    'permet de créer un UserForm
    Public Sub NewUsf(Caption As String, Width As Double, Height As Double)
    Set Usf2 = ThisWorkbook.VBProject.VBComponents.Add(3)
    Nom = Usf2.Name
      VBA.UserForms.Add (Nom)
     Set Usf = UserForms(UserForms.Count - 1)
    With Usf
        .Caption = Caption
        .Width = Width
        .Height = Height
      End With
     
    End Sub
    'Ouvre le UserForm
    Public Sub Show()
    Usf_Initialize
    Usf.Show
    End Sub
    'Permet d'ajouter un bouton
    Sub NewBouton(Name As String, Caption As String, Width As Double, Height As Double, Left As Double, Top As Double)
    If Dico.EXISTS(Name) = True Then Exit Sub
    Dim cls As New Classe1
     Set cls.Bouton = Usf.Controls.Add("forms.CommandButton.1")
     Set cls.Usf = Usf
        With cls.Bouton
            .Name = Name
            .Caption = Caption
            .Width = Width
            .Height = Height
            .Left = Left
            .Top = Top
        End With
     
       Dico.Add Name, cls
       Set cls = Nothing
    End Sub
    'permet de supprimer le UserForm
    Private Sub Class_Terminate()
    If Nom <> "" Then
     Set VBComp = ThisWorkbook.VBProject.VBComponents(Nom)
        ThisWorkbook.VBProject.VBComponents.Remove VBComp
    End If
    End Sub
    'L'evennement Click Bouton7 ferme le UserForm
    Private Sub Bouton_Click()
    Select Case Bouton.Name
    Case "Bouton7"
        Unload Usf
    Case Else
        MsgBox Bouton.Name
    End Select
    End Sub
    'code se déclenchant à l'ouverture de Userform1
    Private Sub Usf_Initialize()
    Dim hSysMenu As Long
    Dim MeHwnd As Long
        MeHwnd = FindWindowA(vbNullString, Usf.Caption)
        If MeHwnd > 0 Then
            hSysMenu = GetSystemMenu(MeHwnd, False)
            RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
        Else
            MsgBox "Handle de " & Usf.Caption & " Introuvable", vbCritical
        End If
     
    End Sub
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    Sub test()
    Dim Usf As New Classe1
    'With Me
    '    .Height = Obj.Height + Obj.Top + (5 * (i - 2))
    '    .Width = (Obj.Left * 2) + Obj.Width
    'End With
    Usf.NewUsf "toto", (20 * 2) + 100, (30 * 7) + 5 + (5 * 5)
    'module de classe
    'Public Sub NewUsf(Caption As String, Width As Double, Height As Double)
    'Set Usf2 = ThisWorkbook.VBProject.VBComponents.Add(3)
    'Nom = Usf2.Name
    '  VBA.UserForms.Add (Nom)
    ' Set Usf = UserForms(UserForms.Count - 1)
    'With Usf
    '    .Caption = Caption
    '    .Width = Width
    '    .Height = Height
    '  End With
    '
    'End Sub
    For i = 1 To 7
      Usf.NewBouton "Bouton" & i, "Bouton " & i, 100, 30, 20, 30 * (i - 1) + 5
      'module de classe
    'sub NewBouton(Name As String, Caption As String, Width As Double, Height As Double, Left As Double, Top As Double)
    'If Dico.EXISTS(Name) = True Then Exit Sub
    'Dim cls As New Classe1
    ' Set cls.Bouton = Usf.Controls.Add("forms.CommandButton.1")
    ' Set cls.Usf = Usf
    '    With cls.Bouton
    '        .Name = Name
    '        .Caption = Caption
    '        .Width = Width
    '        .Height = Height
    '        .Left = Left
    '        .Top = Top
    '    End With
    '
    '   Dico.Add Name, cls
    '   Set cls = Nothing
    'End Sub
    Next
     
    Usf.Show
    'Module de classe code se déclenchant à l'ouverture de Userform1
    'pour rendre la croix inopérente!
    'Private Sub Usf_Initialize()
    'Dim hSysMenu As Long
    'Dim MeHwnd As Long
    '    MeHwnd = FindWindowA(vbNullString, Usf.Caption)
    '    If MeHwnd > 0 Then
    '        hSysMenu = GetSystemMenu(MeHwnd, False)
    '        RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
    '    Else
    '        MsgBox "Handle de " & Usf.Caption & " Introuvable", vbCritical
    '    End If
    '
    'End Sub
    End Sub

  3. #23
    Membre émérite
    Avatar de pijaku
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    1 814
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : Août 2010
    Messages : 1 814
    Points : 2 948
    Points
    2 948
    Billets dans le blog
    10
    Par défaut
    Bonjour,

    On en était arrivé là lors de ma réponse du 20/04/2015, 14h58.
    A savoir que l'on avait deux choix :
    - soit on intègre la création des contrôles dans le code appelant (solution de rdurupt 21/04/2015, 16h32),
    cette solution permet de faire réagir les contrôles grâce à la classe
    - soit on ne laisse rien dans la partie appelante que l'appel de notre objet.

    C'est cette seconde possibilité qui a été retenue.
    En effet, laisser la création des contrôles dans la partie appelante, c'est un peu comme vendre une calculatrice sans bouton ni écran.

    Maintenant que le choix s'est porté sur la seconde solution, nous étudions les différentes possibilités pour rendre nos contrôles actifs.

    Pierre a eu l'idée de créer, par code, le code de l'UserForm.
    Cette solution est efficace. Cependant, n'en existe t'il pas une autre?

    N'est-il pas possible d'intégrer au module de classe une sous-classe qui gèrerait les contrôles?

    J'ai lu qu'il était possible de créer des propriétés Objets. Ne peut-on pas s'en servir pour créer les contrôles dans notre UserForm?

    En fait, on touche vraiment là à mes limites de connaissances dans les classes.

    Une solution consisterait à créer deux Modules de classe. Je n'en suis pas fan, mais pourquoi pas après tout.

    Qu'en pensez-vous, vous qui maitrisez davantage cet aspect de la programmation?

    ps : sur ce je vais replonger dans l'étude de la réponse de Pierre Fauconnier à propos de : programmation de type "trois-tiers". Partie que je n'ai toujours pas comprise...
    Cordialement,
    Franck

  4. #24
    Invité
    Invité(e)
    Par défaut
    Bonjour,
    Ma solution travail déjà comme ça puisqu'elle place les boutons dans une autre instance de la même classe!
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    Sub NewBouton(Name As String, Caption As String, Width As Double, Height As Double, Left As Double, Top As Double)
    If Dico.EXISTS(Name) = True Then Exit Sub
    Dim cls As New Classe1
     Set cls.Bouton = Usf.Controls.Add("forms.CommandButton.1")
     Set cls.Usf = Usf
        With cls.Bouton
            .Name = Name
            .Caption = Caption
            .Width = Width
            .Height = Height
            .Left = Left
            .Top = Top
        End With
     
       Dico.Add Name, cls
       Set cls = Nothing
    End Sub
    Dernière modification par Invité ; 22/04/2015 à 09h21.

  5. #25
    Membre émérite
    Avatar de pijaku
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    1 814
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : Août 2010
    Messages : 1 814
    Points : 2 948
    Points
    2 948
    Billets dans le blog
    10
    Par défaut
    Oui. J'ai bien vu cela.
    Mais ce que je ne parviens pas à faire c'est intégrer la boucle de création des contrôles dans le module de classe :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    For i = 1 To 7
      Usf.NewBouton "Bouton" & i, "Bouton " & i, 100, 30, 20, 30 * (i - 1) + 5
    Next
    Ce code ne devrait pas, à terme, rester du côté appel de l'objet.
    Cordialement,
    Franck

  6. #26
    Responsable
    Office & Excel


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    Novembre 2003
    Messages
    19 122
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : Novembre 2003
    Messages : 19 122
    Points : 55 955
    Points
    55 955
    Billets dans le blog
    131
    Par défaut
    Il faudra que je me penche sur la solution de rdurupt, car je ne l'ai pas encore mise en pratique.


    Citation Envoyé par pijaku Voir le message
    [...]

    N'est-il pas possible d'intégrer au module de classe une sous-classe qui gèrerait les contrôles?

    J'ai lu qu'il était possible de créer des propriétés Objets. Ne peut-on pas s'en servir pour créer les contrôles dans notre UserForm?
    [...]
    Tu peux créer une propriété Objet, mais elle aura besoin de son module de classe => deux modules... Alors que c'est ce que nous cherchons à éviter...

    Citation Envoyé par pijaku Voir le message
    [...]Une solution consisterait à créer deux Modules de classe. Je n'en suis pas fan, mais pourquoi pas après tout.[...]
    Voir ma remarque précédente!

    Donc pour moi, si l'on veut un seul module, on doit forcément créer le code à l'intérieur de ce module. Dans la mesure où l'on peut créer le userform avant pour le tester, je ne vois pas trop le problème...
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes billets de blog sur DVP
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

  7. #27
    Invité
    Invité(e)
    Par défaut
    Code classe : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    #If VBA7 Then
        Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare PtrSafe  Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
        Private Declare PtrSafe  Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
        Private Declare  PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     #Else
        Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
        Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
        Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    #End If
    Private Const SC_CLOSE = &HF060&
    Private Const MF_BYCOMMAND = &H0&
     Dim hwnd As Long, Style As Long
    Public Usf As Object
    Private Nom As String
    Private Dico As Object
     
    Public WithEvents Bouton As MSForms.CommandButton
    'Initialise la collection
    Private Sub Class_Initialize()
     Set Dico = CreateObject("Scripting.dictionary")
    End Sub
    'permet de créer un UserForm
    Private Sub NewUsf(Caption As String, Width As Double, Height As Double)
    Set Usf2 = ThisWorkbook.VBProject.VBComponents.Add(3)
    Nom = Usf2.Name
      VBA.UserForms.Add (Nom)
     Set Usf = UserForms(UserForms.Count - 1)
    With Usf
        .Caption = Caption
        .Width = Width
        .Height = Height
      End With
     
    End Sub
    'Ouvre le UserForm
    Public Sub Show()
    NewUsf "toto", (20 * 2) + 100, (30 * 7) + 5 + (5 * 5)
    For i = 1 To 7
      NewBouton "Bouton" & i, "Bouton " & i, 100, 30, 20, 30 * (i - 1) + 5
    Next
    Usf_Initialize
    Usf.Show
    End Sub
    'Permet d'ajouter un bouton
    Private Sub NewBouton(Name As String, Caption As String, Width As Double, Height As Double, Left As Double, Top As Double)
    If Dico.EXISTS(Name) = True Then Exit Sub
    Dim cls As New Classe1
     Set cls.Bouton = Usf.Controls.Add("forms.CommandButton.1")
     Set cls.Usf = Usf
        With cls.Bouton
            .Name = Name
            .Caption = Caption
            .Width = Width
            .Height = Height
            .Left = Left
            .Top = Top
        End With
     
       Dico.Add Name, cls
       Set cls = Nothing
    End Sub
    'permet de supprimer le UserForm
    Private Sub Class_Terminate()
    If Nom <> "" Then
     Set VBComp = ThisWorkbook.VBProject.VBComponents(Nom)
        ThisWorkbook.VBProject.VBComponents.Remove VBComp
    End If
    End Sub
    'L'evennement Click Bouton7 ferme le UserForm
    Private Sub Bouton_Click()
    Select Case Bouton.Name
    Case "Bouton7"
        Unload Usf
    Case Else
        MsgBox Bouton.Name
    End Select
    End Sub
    'code se déclenchant à l'ouverture de Userform1
    Private Sub Usf_Initialize()
    Dim hSysMenu As Long
    Dim MeHwnd As Long
        MeHwnd = FindWindowA(vbNullString, Usf.Caption)
        If MeHwnd > 0 Then
            hSysMenu = GetSystemMenu(MeHwnd, False)
            RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
        Else
            MsgBox "Handle de " & Usf.Caption & " Introuvable", vbCritical
        End If
     
    End Sub
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Sub test()
    Dim Usf As New Classe1
    Usf.Show
    End Sub

  8. #28
    Membre émérite
    Avatar de pijaku
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    1 814
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : Août 2010
    Messages : 1 814
    Points : 2 948
    Points
    2 948
    Billets dans le blog
    10
    Par défaut
    J'en étais arrivé au même code que rdurupt à deux détails près :

    => suppression de la procédure Initialize.
    Dans le cas de ce code, il n'y a aucun problème de fermeture par la croix.

    => déclaration public de la variable (monUsf) de type Classe1 dans la procédure d'appel

    => ajout dans la procédure click du bouton Case Bouton7 : pour terminer la classe
    Cordialement,
    Franck

  9. #29
    Invité
    Invité(e)
    Par défaut
    mais tu peux affecter une macro différente pour chaque boutons!
    'L'evennement Click Bouton7 ferme le UserForm
    Code Classe : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    Private Sub Bouton_Click()
    Select Case Bouton.Name
        Case "Bouton1"
            Macro1
        Case "Bouton2"
            Macro2
        Case "Bouton3"
            Macro3
        Case "Bouton4"
            Macro4
        Case "Bouton5"
            Macro5
        Case "Bouton6"
            Macro6
        Case "Bouton7"
            Macro7
    End Select
    End Sub
    Sub Macro1()
    MsgBox "Macro1"
    End Sub
    Sub Macro2()
    MsgBox "Macro2"
    End Sub
    Sub Macro3()
    MsgBox "Macro3"
    End Sub
    Sub Macro4()
    MsgBox "Macro4"
    End Sub
    Sub Macro5()
    MsgBox "Macro5"
    End Sub
    Sub Macro6()
    MsgBox "Macro6"
    End Sub
    Sub Macro7()
     Unload Usf
    End Sub
    voir exécuter une macro défini dans un XLAM!
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    Case "Bouton1"
    run "xla.macroxx"

  10. #30
    Membre émérite
    Avatar de pijaku
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    1 814
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : Août 2010
    Messages : 1 814
    Points : 2 948
    Points
    2 948
    Billets dans le blog
    10
    Par défaut
    mais tu peux affecter une macro différente pour chaque boutons!
    Je n'ai jamais dit le contraire.
    J'ai juste dit que j'en étais arrivé au même résultat ce matin avec ton code proposé hier.

    J'aimerais bien le retour de Pierre sur cette façon de faire.

    Mais, en attendant, peux tu m'expliquer le pourquoi du comment du fonctionnement de l'objet dictionary...
    Je ne saisi pas bien comment il fonctionne.
    En fait, à chaque fois que tu créées une instance de classe, tu créées un nouveau dictionary.
    Or, au final, il s'avère que cet objet (Dico) est unique et comprend bien tous les éléments de la collection d'objets...

    Par contre, je persiste et signe, il ne sert à rien d'annuler l'action de la croix de l'userform dans le cas de ton code.
    J'ai donc supprimé toutes les références aux apis et la procédure Usf_Initialize.
    Cette partie est inutile, la fermeture de l'userform par la croix n'engendrant pas d'erreur.
    Cordialement,
    Franck

  11. #31
    Invité
    Invité(e)
    Par défaut
    bonjour,
    Je n'ai jamais dit le contraire.
    J'ai juste dit que j'en étais arrivé au même résultat ce matin avec ton code proposé hier.
    oui je n'es pas dit le contraire; c'était une précision à la cantonade qui ne visait personne en particulier!
    Mais, en attendant, peux tu m'expliquer le pourquoi du comment du fonctionnement de l'objet dictionary...
    Je ne saisi pas bien comment il fonctionne.
    le dictionary est une collection mais elle est plus souple car elle permet de vérifier si un objet existe par sa clé! Dico.EXISTS(Name) = True Then Exit Sub.
    nous ajoutons un objet; dans notre cas une classe en lui attribuant un nom (Clé): Dico.Add Clé, Classe.
    il s'avère que cet objet (Dico) est unique et comprend bien tous les éléments de la collection d'objets...
    oui tu as raison; mais imagine que je désire ajouter un MultiPage! et lui affecter des contrôles! la mon sou-Dico serra utile! il est préférable d'enticiper les demande que de modifier l'existant pour un rélize.
    Par contre, je persiste et signe, il ne sert à rien d'annuler l'action de la croix de l'userform dans le cas de ton code.
    oui ça je m'en fiche (tu en faits ce que tu veux!) mais j'ai vu dans le fils qu'il en était plus ou moins question au post #18!

    Je ne suis pas là pour imposer mes vues, mais pour proposer une solution.
    Tu peux l'utiliser telle qu'elle, la modifier par tes propres idées ou elles d'autres contributeurs et même en choisir une autre.

    Dans tous les cas. Je ne me sentirai pas offensé! Tu es le maître d'œuvre.
    Dernière modification par Invité ; 22/04/2015 à 11h42.

  12. #32
    Membre émérite
    Avatar de pijaku
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    1 814
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : Août 2010
    Messages : 1 814
    Points : 2 948
    Points
    2 948
    Billets dans le blog
    10
    Par défaut
    Merci pour ces précisions.
    On a vu comment ajouter des contrôles à cet userform, mais comment faire pour les supprimer proprement?
    Supposons, dans l'exemple donné par rdurupt que je souhaites supprimer le bouton Bouton2.
    Cordialement,
    Franck

  13. #33
    Invité
    Invité(e)
    Par défaut
    Code classe : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    Private sub SuppNouton(Nom)
    Usf.controls.remove cstr(nom)
    Dico.remove nom
    End sub
     
    'permet de supprimer le UserForm
    Private Sub Class_Terminate()
    If Nom <> "" Then
     Set VBComp = ThisWorkbook.VBProject.VBComponents(Nom)
        ThisWorkbook.VBProject.VBComponents.Remove VBComp
    Else
      Usf.controls.remove cstr(bouton.name)
    End if
    Set Dico= nothing
    End  Sub
    Dernière modification par Invité ; 22/04/2015 à 22h15.

  14. #34
    Responsable
    Office & Excel


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    Novembre 2003
    Messages
    19 122
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : Novembre 2003
    Messages : 19 122
    Points : 55 955
    Points
    55 955
    Billets dans le blog
    131
    Par défaut
    Perso, je préfère la méthode de rdurupt à la mienne, car elle permet d'avoir le code de gestion en clair dans la classe, ce qui est plus maintenable.

    Et on peut ajouter autre chose que des boutons à la collection des contrôles. Le code de la classe peut alors récupérer les valeurs saisies dans les textbox, les valeurs des checkbox et autres. Cela permet alors d'avoir effectivement un "userform".

    Cela étant, l'idée est tout de même d'avoir un userform dont le nombre (et éventuellement le type de contrôles) sont modifiables par la procédure appelante du userform. Il faudra donc, comme le propose rdurupt:
    • soit que la procédure appelante puisse passer un tableau de contrôles qui seront créés (cela limite les possibilités de développement de code métier à l'intérieur de la classe);
    • soit qu'avant d'activer une méthode Show, on puisse alimenter la collection des contrôles. (comme le montrait rdurupt dans son message de hier 14h12.


    Parce qu'un simple appel de type maclasse.show n'a aucun sens puisque le formulaire créé serait toujours le même. Dans ce cas, autant avoir le userform directement, non?

    Donc, perso, j'opterai pour une méthode dynamique qui construit tout en une seule passe, du genre maclasse.show caption, left, top, width, height, controls_table...
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes billets de blog sur DVP
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

  15. #35
    Invité
    Invité(e)
    Par défaut
    Bonsoir Pierre,
    d'accord avec toi; sauf s’offrir un exercice de style, du genre moi je sais faire, cela revient comme tu l'as dit à un UserForm standard!

    la génération dans un module standard des contrôles, permet un chaînage des dicos Usf.dico("MultiPage").NewBouton("etc...")ainsi de générer tout ou presque; seule l'imagination et la technique pourrait en limité le processus!

  16. #36
    Membre émérite
    Avatar de pijaku
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    1 814
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : Août 2010
    Messages : 1 814
    Points : 2 948
    Points
    2 948
    Billets dans le blog
    10
    Par défaut
    Bonjour Messieurs,

    Je vais tenter d'être clair.
    @Pierre Fauconnier
    Parce qu'un simple appel de type maclasse.show n'a aucun sens puisque le formulaire créé serait toujours le même. Dans ce cas, autant avoir le userform directement, non?
    Oui et non en fait. Ma question initiale le montre d'ailleurs.
    A titre d'exemple (bidon mais explicite) :
    Soit un Userform comportant 365 boutons (un par jour). Le clic sur un bouton renvoie le jour cliqué.
    En utilisant uniquement un UserForm, le développeur se doit d'écrire 365 Sub événementielle CommandButtonXXX_Click.
    Il peut donc, pour se simplifier la vie utiliser 1 UserForm et 1 Classe ce qui "complique" le "travail" de l'utilisateur.
    Notre méthode permet ainsi de simplifier le travail du développeur en lui permettant de "livrer" un produit simple d'utilisation.
    Le fait de disposer d'une classe permet également de donner à la disposition de l'utilisateur une propriété Value à son objet.
    Ainsi, l'utilisation dans son classeur est rendue encore plus aisée. Chaque utilisateur, même novice, sachant quoi faire avec monObjet.Value.
    Soit il veut la valeur dans une cellule : [B5] = monObjet.Value, soit il la veut dans un TextBox de son Userform : Me.Textbox1 = monObjet.Value.
    [ps : ceci est faisable également avec un userform, mais de manière un peu plus "complexe" pour l'utilisateur, je trouve en tous cas.]

    Le code de la classe peut alors récupérer les valeurs saisies dans les textbox, les valeurs des checkbox et autres.
    J'ai justement beaucoup de mal à récupérer ces valeurs, lors d'un clic sur un bouton, etc...
    Mais à force de tentatives, je devrais trouver... ou pas

    Cela étant, l'idée est tout de même d'avoir un userform dont le nombre (et éventuellement le type de contrôles) sont modifiables par la procédure appelante du userform.
    Oui, mais de manière simplifiée.
    La collection des contrôles prévue pour telle ou telle configuration de l'userform devrait, selon moi, être développée, au sein de la classe, afin que l'appel en reste simplifié.
    Par exemple (en faux code) :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Sub Appel()
      MonObjet.Show 1
    End Sub
    dans la classe
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    Sub Show(QuelUsf As Integer)
    Select Case QuelUsf
      Case 1: 
      Case 2:
    End Select
    End Sub
    @rdurupt
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Private sub SuppNouton(Nom)
    Usf.controls.remove cstr(nom)
    Dico.remove nom
    End sub
    Ce n'est pas ce que je demandais en fait. ça, je sais faire (il est vrai que ne se connaissant pas, il est toujours difficile d'évaluer le niveau d'un correspondant sur un forum).
    En fait, lors de la création d'un nouveau bouton, on créé une nouvelle instance de classe.
    Comment la supprimer lors de la destruction de ce contrôle?
    Est ce possible et surtout est ce utile?
    Supposons à l’extrême, que notre objet comporte des milliers de contrôles à créer et effacer plusieurs fois dans la même utilisation.
    Cela ne va t'il pas engendrer une "saturation" de la mémoire?

    la génération dans un module standard des contrôles, permet un chaînage des dicos Usf.dico("MultiPage").NewBouton("etc...")ainsi de générer tout ou presque
    Une fois de plus, vous atteignez ici la limite de mes connaissances.
    Pourrais-tu, stp, nous "bricoler" un petit exemple afin que je comprennes là ou tu veux en venir?

    En tout cas, merci pour le suivi et le partage de vos connaissances.
    Cordialement,
    Franck

  17. #37
    Invité
    Invité(e)
    Par défaut
    Bonjour,
    on libère les instance dans la méthode Class_Terminate().
    vue que Dico contient les instances il suffit de libérer Set Dico = Nothing pour supprimer toutes les instance!

    les contrôles sont décharger avec le unload Usf vue qu'il font partie intégrante du Usf.Controls.Add("forms.CommandButton.1")!
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    permet de supprimer le UserForm
    Private Sub Class_Terminate()
     Set Dico = Nothing
    If Nom <> "" Then
        Set VBComp = ThisWorkbook.VBProject.VBComponents(Nom)
        ThisWorkbook.VBProject.VBComponents.Remove VBComp
    End If
    End Sub
    dans l'exemple suivant, j'ai remplace Bouton1 par textbox1

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    #If VBA7 Then
        Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare PtrSafe  Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
        Private Declare PtrSafe  Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
        Private Declare  PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     #Else
        Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
        Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
        Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    #End If
    Private Const SC_CLOSE = &HF060&
    Private Const MF_BYCOMMAND = &H0&
     Dim hwnd As Long, Style As Long
    Public Usf As Object
    Private Nom As String
    Private Dico As Object
     
    Public WithEvents Bouton As MSForms.CommandButton
    Public WithEvents Text As MSForms.TextBox
     
     
    'Initialise la collection
    Private Sub Class_Initialize()
     Set Dico = CreateObject("Scripting.dictionary")
    End Sub
    Private Sub NewTxt(Name As String, TxtDefaut As String, Width As Double, Height As Double, Left As Double, Top As Double)
    If Dico.EXISTS(Name) = True Then Exit Sub
    Dim cls As New Classe1
      Set cls.Text = Usf.Controls.Add("forms.Textbox.1")
     Set cls.Usf = Usf
        With cls.Text
            .Name = Name
            .Text = TxtDefaut
            .Width = Width
            .Height = Height
            .Left = Left
            .Top = Top
        End With
     
       Dico.Add Name, cls
       Set cls = Nothing
    End Sub
    'permet de créer un UserForm
    Private Sub NewUsf(Caption As String, Width As Double, Height As Double)
    Set Usf2 = ThisWorkbook.VBProject.VBComponents.Add(3)
    Nom = Usf2.Name
      VBA.UserForms.Add (Nom)
     Set Usf = UserForms(UserForms.Count - 1)
    With Usf
        .Caption = Caption
        .Width = Width
        .Height = Height
      End With
     
    End Sub
    'Ouvre le UserForm
    Public Sub Show()
     
    NewUsf "toto", (20 * 2) + 100, (30 * 7) + 5 + (5 * 5)
    NewTxt "TxtBox1", "Bouton", 100, 30, 20, 30 * (1 - 1) + 5
    For I = 2 To 7
      NewBouton "Bouton" & I, "Bouton " & I, 100, 30, 20, 30 * (I - 1) + 5
    Next
    Usf_Initialize
    Usf.Show
    End Sub
    'Permet d'ajouter un bouton
    Private Sub NewBouton(Name As String, Caption As String, Width As Double, Height As Double, Left As Double, Top As Double)
    If Dico.EXISTS(Name) = True Then Exit Sub
    Dim cls As New Classe1
      Set cls.Bouton = Usf.Controls.Add("forms.CommandButton.1")
     Set cls.Usf = Usf
        With cls.Bouton
            .Name = Name
            .Caption = Caption
            .Width = Width
            .Height = Height
            .Left = Left
            .Top = Top
        End With
     
       Dico.Add Name, cls
       Set cls = Nothing
     
     
    End Sub
     
    'permet de supprimer le UserForm
    Private Sub Class_Terminate()
    Dim I As Integer
     Set Dico = Nothing
    If Nom <> "" Then
        Set VBComp = ThisWorkbook.VBProject.VBComponents(Nom)
        ThisWorkbook.VBProject.VBComponents.Remove VBComp
    End If
    End Sub
    'L'evennement Click Bouton7 ferme le UserForm
    Private Sub Bouton_Click()
    Select Case Bouton.Name
    Case "Bouton7"
        Unload Usf
    Case Else
        MsgBox Bouton.Name
    End Select
    End Sub
    'code se déclenchant à l'ouverture de Userform1
    Private Sub Usf_Initialize()
    Dim hSysMenu As Long
    Dim MeHwnd As Long
        MeHwnd = FindWindowA(vbNullString, Usf.Caption)
        If MeHwnd > 0 Then
            hSysMenu = GetSystemMenu(MeHwnd, False)
            RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
        Else
            MsgBox "Handle de " & Usf.Caption & " Introuvable", vbCritical
        End If
     
    End Sub
    Dernière modification par Invité ; 23/04/2015 à 10h44.

  18. #38
    Membre émérite
    Avatar de pijaku
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    1 814
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : Août 2010
    Messages : 1 814
    Points : 2 948
    Points
    2 948
    Billets dans le blog
    10
    Par défaut
    La procédure de suppression de contrôle ne fonctionne pas chez moi.
    Voici comment je l'utilises :
    Code de la classe Classe1 :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
            Public Usf As Object
            Private Nom As String
            Private Dico As Object
     
            Public WithEvents Bouton As MSForms.CommandButton
            Public WithEvents Text As MSForms.TextBox
     
            'Initialise la collection
            Private Sub Class_Initialize()
             Set Dico = CreateObject("Scripting.dictionary")
            End Sub
     
            Private Sub NewTxt(Name As String, TxtDefaut As String, Width As Double, Height As Double, Left As Double, Top As Double)
            If Dico.exists(Name) = True Then Exit Sub
            Dim cls As New Classe1
              Set cls.Text = Usf.Controls.Add("forms.Textbox.1")
             Set cls.Usf = Usf
                With cls.Text
                    .Name = Name
                    .Text = TxtDefaut
                    .Width = Width
                    .Height = Height
                    .Left = Left
                    .Top = Top
                End With
               Dico.Add Name, cls
               Set cls = Nothing
            End Sub
            'permet de créer un UserForm
            Private Sub NewUsf(Caption As String, Width As Double, Height As Double)
            Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3)
            Nom = Usf.Name
            VBA.UserForms.Add (Nom)
            Set Usf = UserForms(UserForms.Count - 1)
            With Usf
                .Caption = Caption
                .Width = Width
                .Height = Height
              End With
            End Sub
            'Ouvre le UserForm
            Public Sub Show()
     
            NewUsf "toto", (20 * 2) + 100, (30 * 7) + 5 + (5 * 5)
            NewTxt "TxtBox1", "Bouton", 100, 30, 20, 30 * (1 - 1) + 5
            For I = 2 To 7
              NewBouton "Bouton" & I, "Bouton " & I, 100, 30, 20, 30 * (I - 1) + 5
            Next
            Usf.Show
            End Sub
            'Permet d'ajouter un bouton
            Private Sub NewBouton(Name As String, Caption As String, Width As Double, Height As Double, Left As Double, Top As Double)
            If Dico.exists(Name) = True Then Exit Sub
            Dim cls As New Classe1
              Set cls.Bouton = Usf.Controls.Add("forms.CommandButton.1")
             Set cls.Usf = Usf
                With cls.Bouton
                    .Name = Name
                    .Caption = Caption
                    .Width = Width
                    .Height = Height
                    .Left = Left
                    .Top = Top
                End With
     
               Dico.Add Name, cls
               Set cls = Nothing
     
            End Sub
     
            'permet de supprimer le UserForm
            Private Sub Class_Terminate()
            Dim I As Integer
            Set Dico = Nothing
            If Nom <> "" Then
                Set VBComp = ThisWorkbook.VBProject.VBComponents(Nom)
                ThisWorkbook.VBProject.VBComponents.Remove VBComp
            End If
            End Sub
            'L'evennement Click Bouton7 ferme le UserForm
            Private Sub Bouton_Click()
            Select Case Bouton.Name
            Case "Bouton7"
                Unload Usf
            Case Else
                SuppBouton Bouton.Name
            End Select
            End Sub
            Private Sub SuppBouton(Nom)
            Usf.Controls.Remove CStr(Nom)
            If Dico.exists(Nom) Then
                Dico.Remove Nom
            End If
            End Sub
    Lors d'un clic sur un des boutons de 2 à 6, le contrôle est supprimé de l'userform, mais pas du Dico.
    Par ailleurs, si j’inscris dans la procédure SuppBouton : Debug.Print Dico.Count, le résultat est 0.
    Peut être est ce que je l'appelle mal?? Code d'appel :
    Cordialement,
    Franck

  19. #39
    Invité
    Invité(e)
    Par défaut
    Lors d'un clic sur un des boutons de 2 à 6, le contrôle est supprimé de l'userform, mais pas du Dico.
    Par ailleurs, si j’inscris dans la procédure SuppBouton : Debug.Print Dico.Count, le résultat est 0.
    Peut être est ce que je l'appelle mal?? Code d'appel :
    un module de classe est un modèle!
    chaque instance de la casse contient un Dico. l'idée est d’établir un hiérarchie!
    Usf.dico.count=7
    Usf.dico("Bouton6").dico.count=0 effectivement tu te trouve dans l'instance du bouton6!

    mais en soit ce n'est pas gainant en suppression là ou ça le devient c'est si sur un autre bouton tu veux le recréer après suppression car là il faut tester si existe mais également if tymname(dico("Bouton6") )="Nothng" then 'on ajoute bouton6on revient à ce que je disais plus haut
    eule l'imagination et la technique pourrait en limité le processus!
    voici une version avec les contrôles dans un frame!
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    #If VBA7 Then
        Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare PtrSafe  Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
        Private Declare PtrSafe  Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
        Private Declare  PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     #Else
        Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
        Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
        Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    #End If
    Private Const SC_CLOSE = &HF060&
    Private Const MF_BYCOMMAND = &H0&
     Dim hwnd As Long, Style As Long
    Public Usf As Object
    Private Nom As String
    Public Dico As Object
    Public TypeObjet As String
    Public WithEvents Bouton As MSForms.CommandButton
    Public WithEvents Text As MSForms.TextBox
    Public WithEvents FRM As MSForms.Frame
     
     
     
    'Initialise la collection
    Private Sub Class_Initialize()
     Set Dico = CreateObject("Scripting.dictionary")
    End Sub
    Public Sub NewTxt(Name As String, TxtDefaut As String, Width As Double, Height As Double, Left As Double, Top As Double)
    If Dico.EXISTS(Name) = True Then Exit Sub
    Dim cls As New Classe1
      Set cls.Text = Usf.Controls.Add("forms.Textbox.1")
     Set cls.Usf = Usf
        With cls.Text
            .Name = Name
            .Text = TxtDefaut
            .Width = Width
            .Height = Height
            .Left = Left
            .Top = Top
        End With
     
       Dico.Add Name, cls
       Set cls = Nothing
    End Sub
    'permet de créer un UserForm
    Private Sub NewUsf(Caption As String, Width As Double, Height As Double)
    Set Usf2 = ThisWorkbook.VBProject.VBComponents.Add(3)
    Nom = Usf2.Name
      VBA.UserForms.Add (Nom)
     Set Usf = UserForms(UserForms.Count - 1)
     TypeObjet = "UserForm"
    With Usf
        .Caption = Caption
        .Width = Width
        .Height = Height
      End With
     
    End Sub
    'Ouvre le UserForm
    Public Sub Show()
     
    NewUsf "toto", (20 * 2) + 100, (30 * 7) + 5 + (5 * 5)
    NewFrme "Fram1", "toto", (18 * 2) + 100, (30 * 7) + 3 + (5 * 5), 3, 3
    'Dico("Fram1").NewTxt "TxtBox1", "Bouton", 100, 30, 20, 30 * (1 - 1) + 5
    For I = 1 To 7
      Dico("Fram1").NewBouton "Bouton" & I, "Bouton " & I, 100, 30, 20, 30 * (I - 1) + 5
    Next
    Usf_Initialize
    Usf.Show
    End Sub
    Public Sub NewFrme(Name As String, Caption As String, Width As Double, Height As Double, Left As Double, Top As Double)
    If Dico.EXISTS(Name) = True Then Exit Sub
    Dim cls As New Classe1
         Select Case TypeObjet
        Case "UserForm"
            Set cls.FRM = Usf.Controls.Add("forms.frame.1")
        Case "Frame"
            Set cls.FRM = FRM.Controls.Add("forms.frm.1")
        End Select
        cls.TypeObjet = "Frame"
        Set cls.Usf = Usf
        With cls.FRM
            .Name = Name
            .Caption = Caption
            .Width = Width
            .Height = Height
            .Left = Left
            .Top = Top
        End With
     
       Dico.Add Name, cls
       Set cls = Nothing
    End Sub
    'Permet d'ajouter un bouton
    Public Sub NewBouton(Name As String, Caption As String, Width As Double, Height As Double, Left As Double, Top As Double)
    If Dico.EXISTS(Name) = True Then Exit Sub
    Dim cls As New Classe1
     Select Case TypeObjet
        Case "UserForm"
            Set cls.Bouton = Usf.Controls.Add("forms.CommandButton.1")
        Case "Frame"
            Set cls.Bouton = FRM.Controls.Add("forms.CommandButton.1")
        End Select
     Set cls.Usf = Usf
        With cls.Bouton
            .Name = Name
            .Caption = Caption
            .Width = Width
            .Height = Height
            .Left = Left
            .Top = Top
        End With
     
       Dico.Add Name, cls
       Set cls = Nothing
     
     
    End Sub
     
    'permet de supprimer le UserForm
    Private Sub Class_Terminate()
    Dim I As Integer
     Set Dico = Nothing
    If Nom <> "" Then
        Set VBComp = ThisWorkbook.VBProject.VBComponents(Nom)
        ThisWorkbook.VBProject.VBComponents.Remove VBComp
    End If
    End Sub
    'L'evennement Click Bouton7 ferme le UserForm
    Private Sub Bouton_Click()
    Select Case Bouton.Name
    Case "Bouton7"
        Unload Usf
    Case Else
        MsgBox Bouton.Name
    End Select
    End Sub
    'code se déclenchant à l'ouverture de Userform1
    Private Sub Usf_Initialize()
    Dim hSysMenu As Long
    Dim MeHwnd As Long
        MeHwnd = FindWindowA(vbNullString, Usf.Caption)
        If MeHwnd > 0 Then
            hSysMenu = GetSystemMenu(MeHwnd, False)
            RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
        Else
            MsgBox "Handle de " & Usf.Caption & " Introuvable", vbCritical
        End If
     
    End Sub
    avec un MultiPage!
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    #If VBA7 Then
        Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare PtrSafe  Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
        Private Declare PtrSafe  Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
        Private Declare  PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     #Else
        Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
        Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
        Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    #End If
    Private Const SC_CLOSE = &HF060&
    Private Const MF_BYCOMMAND = &H0&
     Dim hwnd As Long, Style As Long
    Public Usf As Object
    Private Nom As String
    Public Dico As Object
    Public TypeObjet As String
    Public WithEvents Bouton As MSForms.CommandButton
    Public WithEvents Text As MSForms.TextBox
    Public WithEvents FRM As MSForms.Frame
    Public WithEvents MultiPage As MSForms.MultiPage
     
     
    Private Function NewControl(Controle As String, Page As Integer)
    If Dico.EXISTS(Name) = True Then NewControl = Nothing: Exit Function
     Select Case TypeObjet
        Case "UserForm"
            Set NewControl = Usf.Controls.Add(Controle)
        Case "Frame"
            Set NewControl = FRM.Controls.Add(Controle)
        Case "MultiPage"
            Set NewControl = MultiPage(Page).Add(Controle)
        End Select
    End Function
    'Initialise la collection
    Private Sub Class_Initialize()
     Set Dico = CreateObject("Scripting.dictionary")
    End Sub
    Public Sub NewTxt(Name As String, TxtDefaut As String, Width As Double, Height As Double, Left As Double, Top As Double, Optional Page As Integer = 0)
    Dim obj
    Set obj = NewControl("forms.Textbox.1", Page)
    If TypeName(obj) = "Nothing" Then Exit Sub
    Dim cls As New Classe1
      Set cls.Text = obj
     Set cls.Usf = Usf
        With cls.Text
            .Name = Name
            .Text = TxtDefaut
            .Width = Width
            .Height = Height
            .Left = Left
            .Top = Top
        End With
     
       Dico.Add Name, cls
       Set cls = Nothing
    End Sub
    'permet de créer un UserForm
    Private Sub NewUsf(Caption As String, Width As Double, Height As Double)
    Set Usf2 = ThisWorkbook.VBProject.VBComponents.Add(3)
    Nom = Usf2.Name
      VBA.UserForms.Add (Nom)
     Set Usf = UserForms(UserForms.Count - 1)
     TypeObjet = "UserForm"
    With Usf
        .Caption = Caption
        .Width = Width
        .Height = Height
      End With
     
    End Sub
    'Ouvre le UserForm
    Public Sub Show()
     
    NewUsf "toto", (120 * 2) + 100, (30 * 7) + 5 + (5 * 5)
    NewFrme "Fram1", "toto", (18 * 2) + 100, (30 * 7) + 3 + (5 * 5), 3, 3
    NewMulitPage "MulitPage1", "toto", (110 * 2) + 100, (30 * 7) + 3 + (5 * 5), 3, 3, 7, 0, "Bouton 1", "Bouton 2", "Bouton 3", "Bouton 4", "Bouton 5", "Bouton 6", "Bouton 7"
     
    For I = 1 To 7
        Dico("MulitPage1").NewFrme "Fram" & I, "toto", (18 * 2) + 100, (30 * 7) + 3 + (5 * 5), 3, 3, I - 1
      Dico("MulitPage1").Dico("Fram" & I).NewBouton "Bouton" & I, "Bouton " & I, 100, 30, 20, 30 * 5
    Next
    Usf_Initialize
    Usf.Show
    End Sub
    Public Sub NewMulitPage(Name As String, Caption As String, Width As Double, Height As Double, Left As Double, Top As Double, Nb As Integer, Page As Integer, ParamArray Onglets())
    Dim obj
    Set obj = NewControl("forms.MultiPage.1", Page)
    If TypeName(obj) = "Nothing" Then Exit Sub
     Dim cls As New Classe1
     
     Set cls.Usf = Usf
      Set cls.MultiPage = obj
     
       n = cls.MultiPage.Pages.Count
      n = Nb - n
     For I = 1 To n
        cls.MultiPage.Pages.Add
      Next
      For I = 0 To UBound(Onglets)
       cls.MultiPage.Pages(I).Caption = CStr(Onglets(I))
      Next
        cls.TypeObjet = "MultiPage"
     
        With cls.MultiPage
            .Name = Name
            '.Caption = Caption
            .Width = Width
            .Height = Height
            .Left = Left
            .Top = Top
        End With
     
       Dico.Add Name, cls
       Set cls = Nothing
    End Sub
    Public Sub NewFrme(Name As String, Caption As String, Width As Double, Height As Double, Left As Double, Top As Double, Optional Page As Integer = 0)
    Dim obj
    Set obj = NewControl("forms.frame.1", Page)
    If TypeName(obj) = "Nothing" Then Exit Sub
     Dim cls As New Classe1
     Set cls.Usf = Usf
      Set cls.FRM = obj
        cls.TypeObjet = "Frame"
     
        With cls.FRM
            .Name = Name
            .Caption = Caption
            .Width = Width
            .Height = Height
            .Left = Left
            .Top = Top
        End With
     
       Dico.Add Name, cls
       Set cls = Nothing
    End Sub
    'Permet d'ajouter un bouton
    Public Sub NewBouton(Name As String, Caption As String, Width As Double, Height As Double, Left As Double, Top As Double, Optional Page As Integer = 0)
    Dim obj
    Set obj = NewControl("forms.CommandButton.1", Page)
    If obj = True Then Exit Sub
     Dim cls As New Classe1
     Set cls.Usf = Usf
     Set cls.Bouton = obj
        With cls.Bouton
            .Name = Name
            .Caption = Caption
            .Width = Width
            .Height = Height
            .Left = Left
            .Top = Top
        End With
     
       Dico.Add Name, cls
       Set cls = Nothing
     
     
    End Sub
     
    'permet de supprimer le UserForm
    Private Sub Class_Terminate()
    Dim I As Integer
     Set Dico = Nothing
    If Nom <> "" Then
        Set VBComp = ThisWorkbook.VBProject.VBComponents(Nom)
        ThisWorkbook.VBProject.VBComponents.Remove VBComp
    End If
    End Sub
    'L'evennement Click Bouton7 ferme le UserForm
    Private Sub Bouton_Click()
    Select Case Bouton.Name
    Case "Bouton7"
        Unload Usf
    Case Else
        MsgBox Bouton.Name
    End Select
    End Sub
    'code se déclenchant à l'ouverture de Userform1
    Private Sub Usf_Initialize()
    Dim hSysMenu As Long
    Dim MeHwnd As Long
        MeHwnd = FindWindowA(vbNullString, Usf.Caption)
        If MeHwnd > 0 Then
            hSysMenu = GetSystemMenu(MeHwnd, False)
            RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
        Else
            MsgBox "Handle de " & Usf.Caption & " Introuvable", vbCritical
        End If
     
    End Sub
    Fichiers attachés Fichiers attachés
    Dernière modification par AlainTech ; 27/05/2015 à 23h05. Motif: Fusion de 2 messages

  20. #40
    Membre émérite
    Avatar de pijaku
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    1 814
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : Août 2010
    Messages : 1 814
    Points : 2 948
    Points
    2 948
    Billets dans le blog
    10
    Par défaut
    Merci beaucoup rdurupt.
    Cette phrase résume a elle seule ce qu'il me manquait pour mieux appréhender le sujet :
    un module de classe est un modèle!
    En fait, nous créons des "calques" successifs contenant, pour l'un un Userform, pour l'autre une frame etc... Chacun de ces calques possède une propriété nom, son propre dico etc.
    Si j'ajoute donc une propriété value, chaque "calque" en aura une. C'est ce qui me plantait depuis hier. En cliquant sur un bouton j'alimentait la propriété value...du bouton, celle qui était retournée étant celle de l'usf qui, forcément, était vide.
    Comment faire, mis à part en la stockant dans la propriété tag de l'usf ou en utilisant un contrôle masqué, pour rapporter, au code appelant, la propriété value de l'usf? d'un autre contrôle?
    Y a t'il une méthode plus "académique"?

    Merci encore à tous.

    ps : je regarderais tes exemples demain. Merci encore
    Cordialement,
    Franck

+ Répondre à la discussion
Cette discussion est résolue.
Page 2 sur 3 PremièrePremière 123 DernièreDernière

Discussions similaires

  1. [XL-2003] Clic droit de la souris sur un userform piloté par un module de classe
    Par mormic dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 07/11/2014, 10h58
  2. Réponses: 6
    Dernier message: 02/12/2007, 11h30
  3. Réponses: 8
    Dernier message: 22/02/2006, 16h09
  4. [JSP][Tomcat] COmment choisir la place des fichiers .class?
    Par mathieu dans le forum Tomcat et TomEE
    Réponses: 16
    Dernier message: 03/03/2004, 10h24
  5. Réponses: 14
    Dernier message: 15/01/2004, 02h15

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo