XL 2010 [RESOLU]Adapter Module de Classe

[cp4]

Bonjour,

Je m'initie aux modules de Classe. Merci pour votre aide.

'Module de classe ClsBtn'
Option Explicit

Public WithEvents MESBOUTONS As msforms.CommandButton

Private Sub MESBOUTONS_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   For Each Ctrl In UsFNavigation.Controls
      Ctrl.BackColor = &H8000000F
      Ctrl.ForeColor = &H80000012
   Next
   MESBOUTONS.BackColor = vbGreen
   MESBOUTONS.ForeColor = vbWhite
End Sub

Dans Module UserForm

Option Explicit
Private BTN(1 To 4) As New ClsBtn 'nombre de boutons "4"

Private Sub UserForm_Initialize()
Dim i As Integer
For i = 1 To 4
   Set BTN(i).MESBOUTONS = Me("menu" & i)
Next i

End Sub

Je voudrai remplacer la boucle For i par une boucle For each Ctrl
(sachant que mes boutons commencent tous pas Cb).
Je suis un peu perdu. En vous remerciant.

Bon week-end.

 

[cp4]

Solution ci-dessous dans module de L'userform. Merci à tous ceux et celles qui ont consulté le fil.

Option Explicit

Private BTN As New ClsBtn
Public Col As New Collection

Private Sub UserForm_Initialize()
   Dim i As Integer, Ctrl As Control

   For Each Ctrl In Me.Controls
      If TypeOf Ctrl Is MSForms.CommandButton Then
         Set BTN = New ClsBtn
         Set BTN.MESBOUTONS = Ctrl
         Col.Add BTN
      End If
   Next
End Sub

 

[patricktoulon]

re
tu a encore pas mal à apprendre
tien un autre exemple
je reprends ton fichier post 1
dans le userform
je met un tag "X" à tous tes boutons
dans le module du userform
etencore là c'est la méthode baby vbiste

Option Explicit
Dim Cl As New ClsBtn
Private Sub UserForm_Activate()
Cl.Init Me
End Sub

et dans la classe on va classer tout les controls qui ont un tag "X"
et on va jumeler l'userform dans chaque classe
ainsi dans la classe on aura le mousemove du userform aussi pour remettre la bonne couleur quand on sort du bouton
et on fait bien évidemment la même chose dans le mouve du "MESBOUTONS"

Option Explicit

Public WithEvents MESBOUTONS As msforms.CommandButton
Public WithEvents uf As UserForm
Public usf As Object
Dim cls() As New ClsBtn

'classement des bouton
Public Function Init(uf)
    Dim CtrL, A&
    For Each CtrL In uf.Controls
        If CtrL.Tag = "X" Then
            A = A + 1: ReDim Preserve cls(1 To A): Set cls(A).MESBOUTONS = CtrL: Set cls(A).uf = uf: Set cls(A).usf = uf
        End If
    Next
End Function

'evenement unique  quand on apui le le bouton de la souris  pour les boutons le bouton devient rouge et blanc
Private Sub MESBOUTONS_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    MESBOUTONS.BackColor = vbRed
    MESBOUTONS.ForeColor = vbWhite
End Sub

 'evenement unique  quand on bouge la souris sur le bouton ;le bouton devient vert et blanc
 'le précedent redevient gris
Private Sub MESBOUTONS_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim CtrL
    For Each CtrL In usf.Controls
        If CtrL.Name <> MESBOUTONS.Name Then ' ce "If" sert a eviter de faire clinioter  a chaque fois que l'on bouje sur le même bouton
            With CtrL
                .BackColor = &H8000000F
                .ForeColor = &H80000012
            End With
            MESBOUTONS.BackColor = vbGreen
            MESBOUTONS.ForeColor = vbWhite
        End If
    Next
End Sub


'quand on passe entre les boutons donc  on est dans l'userform mousemouve on  remet le dernier survolé en gris
Private Sub uf_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim CtrL
    For Each CtrL In usf.Controls
        With CtrL
            .BackColor = &H8000000F
            .ForeColor = &H80000012
        End With
    Next
End Sub

 

[cp4]

Bonjour @patricktoulon ,

Merci beaucoup. Toujours là, pour aider avec le sourire. J'apprécie vraiment.
En effet, j'ai encore pas mal à apprendre. Heureusement, que je n'ai aucune contrainte de résultat dans le temps. J'apprends à mon rythme quand je le peux.

je met un tag "X" à tous tes boutons

J'avais tenté cette approche mais je me suis embrouillé.

En fait, je ne connais rien au module de classe. J'ai suivi un tuto sur youtube et je me suis dis: "il faut que je m'y mette". Cependant, en utilisant mon code du post#2, sur un de mes fichiers avec ton code d'affichage du formulaire à la taille de l'écran. Lorsqu'on bouge la souris, on a l'impression que tous les boutons scintillent.

Je n'ai pas encore testé ton présent code. Je le testerai sur l'userform plein écran aussi.

Si je puis me permettre une question: est-il possible de créer un module de classe à partir de ton code plein écran?

Merci beaucoup pour ton aide, ton partage de connaissances et d'expérience.

Bon dimanche.

ps: Ta chaîne Youtube

edit: Ton fichier est super. Vraiment Pro

 

[patricktoulon]

re
non mon fichier n'est pas pro
en fait j'utilise le tag du userform
accessible par toutes les instances de classe
je l'ai fait comme ça pour le niveau débutant

si tu veux du vraiment pro je te fait quelques exemples
c'est pas vraiment compliqué quand on a pigé

Si je puis me permettre une question: est-il possible de créer un module de classe à partir de ton code plein écran?

j'avoue là c'est moi qui pige pas la question

je te fait une video tout à l'heure et je vais texpliquer les choses de façon à ce que tu comprenne la mécanique
tu verra c'est hyper simple en fait

l'erreur que tout débutant fait c'est:
de confondre module classe et Instances de classe
et ignore la possibilité et fonctionnement du subclassing

 

[patricktoulon]

re
ah oui ca y est j'ai pigé
oui c'est normal que ça scintille j'utilise ta boucle
pour remettre tout les boutons a la couleur initiale
comme je disais c'est la méthode BAby vbiste(débutant)
il faut pas oublier que là dans l'exemple que je t'ai donné il y a 3 positions et pas deux
survolé/appuyé/quitté
je suis entrain de te faire des exemple vraiment pro
tu verra la différence

 

[cp4]

Avant tout, je te remercie beaucoup. Je t'avoue qu'il y a beaucoup de chose que je n'ai encore bien compris.
J'essaie d'aider avec mes modestes connaissances avec beaucoup de lacunes.

j'avoue là c'est moi qui pige pas la question

J'ai trouvé ce code ou bien tu me l'as donnée (je ne m'en souviens pas)

Private Sub UserForm_Activate()
   Dim ctl As Control, ratioW As String, ratioH As String
   Set UserActif = Me
   ratioW = Application.Width / Me.Width: ratioH = Application.Height / Me.Height
   Me.Left = 0: Me.Top = 0
   Me.Width = Application.Width: Me.Height = Application.Height
   For Each ctl In Me.Controls
      ctl.Left = ctl.Left * ratioW
      ctl.Top = ctl.Top * ratioH
      ctl.Width = ctl.Width * ratioW
      ctl.Height = ctl.Height * ratioH
      ctl.Font.Size = ctl.Font.Size * ratioH
   Next
End Sub

Peut-on en faire un module de classe pour être utilisé sur plusieurs formulaires mais pas tous d'un classeur?

1000 mercis.

 

[patricktoulon]

re
re oui je m'en souviens de ce code mais c'est pas le dernier
il a des lacunes celui là
alors oui tu pourrais faire mais ça fonctionnerais dans un simple module aussi
mais je supose que tu veux pouvoir le faire sur plusieurs userform éventuellement ouvert en même temps
D’où la raison de passer par une classe

 

[patricktoulon]

re
allez on y va pour presque 1 heure
j'essaie de t'expliquer petit a petit pourquoi ça scintille
et comment on règle le problème
dans le fichier joint tu a une méthode plus précise

je regarde pour ton redimensionnement

 

[cp4]

re
re oui je m'en souviens de ce code mais c'est pas le dernier
il a des lacunes celui là
alors oui tu pourrais faire mais ça fonctionnerais dans un simple module aussi
mais je supose que tu veux pouvoir le faire sur plusieurs userform éventuellement ouvert en même temps
D’où la raison de passer par une classe

Je n'ai pas penser à plusieurs userforms ouverts en même. Mais plus que tu en parles peut-être que oui sur un projet qui cogite dans la petite tête (un userform de navigation qui ouvrirait un autre userform en plein écran).

Ma question pour que ça s'applique à certains userforms du fichier pas tous.

Merci beaucoup.

 

[cp4]

re
allez on y va pour presque 1 heure
j'essaie de t'expliquer petit a petit pourquoi ça scintille
et comment on règle le problème
dans le fichier joint tu a une méthode plus précise

je regarde pour ton redimensionnement

Toute ma gratitude et ma reconnaissance. Très gentil de ta part.
Je n'ai pas encore visionné la vidéo. Je ne doute pas qu'elle est très intéressante et instructive.

Encore merci.

 

[patricktoulon]

re
tout d'abords
quand tu parle de plein ecran c'est compliqué car :
en utilisant l'application comme mesure faut il en core qu'elle soit maximisée
mais bon passons
je constate que des variables ne sont pas du bon type dans ton activate
d'autant plus que tu ne gère pas les controls qui n'ont pas de caption ou de value donc pas font.size
ensuite il y a les listboxs qui ont peut être un columnwidths qui agrandi ne suivent pas dans ta version

berf
je suis aller le récupérer dans un de mes fichiers et je t'ai fait un model

Private Sub UserForm_Activate()
   samesizeApplication Me
End Sub



Sub samesizeApplication(Usf As Object)
 Dim ctl As Control, ratioW#, ratioH#, Cw, tbCw, I&
    With Application: ratioW = .UsableWidth / Usf.Width: ratioH = .Height / Usf.Height: End With
    Usf.Move 0, 0, Usf.Width * ratioW, Usf.Height * ratioH

    For Each ctl In Usf.Controls
        ctl.Move ctl.Left * ratioW, ctl.Top * ratioH, ctl.Width * ratioW, ctl.Height * ratioH
        On Error Resume Next
        ctl.Font.Size = Round(ctl.Font.Size * Application.Min(ratioH, ratioW))
        On Error GoTo 0

        If TypeName(ctl) = "ListBox" Or TypeOf ctl Is ListBox Then
            If ctl.ColumnWidths <> "" Then
                tbCw = Split(Replace(ctl.ColumnWidths, " pt", ""), ";")
                For I = LBound(tbCw) To UBound(tbCw): tbCw(I) = Val(tbCw(I)) * ratioW: Next
                ctl.ColumnWidths = Join(tbCw, ";")
            End If
        End If
    Next
End Sub

cette sub peut très bien aller dans un module et être appelée dans le activate des userform que tu veux
bien que au départ elle est fait pour être exécutée au premier activate d'un userform

j'ai un peu plus complexe si tu veux qui utilise les api pour le plein écran et un redimensionnement dynamique en moins ou en plus c'est pas la même chose

au depart le userform est comme ça

affiché il est comme ça

 

[cp4]

re
allez on y va pour presque 1 heure
j'essaie de t'expliquer petit a petit pourquoi ça scintille
et comment on règle le problème
dans le fichier joint tu a une méthode plus précise

je regarde pour ton redimensionnement

Rebonjour @patricktoulon ,

Je viens juste de terminer ta vidéo. C'est impressionnant, pour moi c'est parfait. Merci infiniment.
Je suis resté sur "ma faim", surtout que tu le soulèves en fin de vidéo, les boutons sont dans des frames (c'est le cas sur beaucoup de mes fichiers), multipages, etc...
Je serai ravi de voir la suite.
Je tenais juste à préciser que les codes dans mon fichier ne sont pas les miens. Mon niveau ne me permet pas de "pondre des codes de module de classe". J'ai suivi une vidéo (Youtube en Français) au pas à pas pour écrire les codes.
Je ne trouve pas de vidéo de ton niveau en langue Française sur Youtube. La plus part sont en anglais. Je ne comprends pas bien cette langue surtout oralement (ils parlent trop vite et mon oreille n'est exercée).
En tout cas, bravo pour ta chaîne et encore merci.

ps: pour le mode plein ne te tracasse pas. C'était juste une question.
Bien que ton code ne soit pas le dernier, il fait bien son boulot dans mes fichiers.

 

[cp4]

Re,

Je reviens vers toi. Je crois que tu t'es trompé de fichier.
En effet, sur la vidéo dans le formulaire "exemple_Switch", les boutons étaient de différentes couleurs.
Dans le fichier joint, ils ne sont pas colorés et le code ne semble pas fonctionnait.
Du moins, il n'y a pas de changement de couleur.
Merci.

 

[patricktoulon]

re
non le switch c'est au click pas au mouve
tu click il devient vert tu sort il reste vert tant que tu clique pas sur un autre
c'est ça le switch

re non le vieux code a des erreurs monumentales
ratiow et ratioh en string par exemple
et le font size ne va pas a tout
les liste box quand on agrandi y compris le font le columnwidths ne correspond plus
si c'est moi qui te l'ai donné comme ça je devais être très fatigué
test celui là
dans les userform tu "a des boutons vers les "autres userform
ballade toi d'userform en userform
il faut bien sur que l'application soit maximisée

garde celle ci va c'est mieux