Déclencher procédure évènementielle click, mouse_up
Bonjour à tous, je cherche à déclencher par code un click physique sur un label.
Ces labels étant gérés via modules de classes, ils déclenchent une procédure qui n'est pas écrite dans le "private sub XXX_click".
Aussi si j'appelle le click par le code ci-dessous, le Sub Label12_Click() se décenche bien... mais comme il est vide (l'évènement se produit via module de classe) il ne se passe rien!
Private Sub TextBox7_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
CallByName UserformBilan, "Label12_Click", VbMethod
End If
End SubJe me suis dit que pour déclencher l'évènement du module de classe il fallait appeller non pas le click mais le mousedown, mais le code ci dessous me met une erreur 438 - propriété ou méthode non gérée par cet objet.
Private Sub TextBox7_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
CallByName UserformBilan, "Label12_MouseDown(1)", VbMethod
End If
End SubAi-je fait une erreur de syntaxe sur le l'appel du mousedown ?
Et sinon par quel moyen pourrais-je déclencher cet évènement du module de classe via un clic ailleurs sur une textbox ?
Merci beaucoup!
Au cas où voici le code du module de classe :
Option Explicit
Public WithEvents clsLbl As MSForms.Label
Private Sub clsLbl_Click()
If Not WidgetExists("TextBox" & Mid(clsLbl.Name, 6)) Then Exit Sub
With clsLbl.Parent.Controls("Textbox" & Mid(clsLbl.Name, 6))
.BackColor = IIf(.BackColor = &HC0E0FF, vbWhite, &HC0E0FF)
End With
End Sub
Private Function WidgetExists(ByVal Name As String) As Boolean
On Error Resume Next
WidgetExists = Not clsLbl.Parent.Controls(Name) Is Nothing
On Error GoTo 0
End FunctionEt le code du set class dans mon userform :
Private Sub SetClass()
Dim myClass As clsLabel
Set Coll = New Collection
Dim ctrl As Control
For Each ctrl In Me.Controls
If TypeName(ctrl) = "Label" Then
Set myClass = New clsLabel: Set myClass.clsLbl = ctrl
Coll.Add myClass
Set myClass = Nothing
End If
Next
End SubBonjour,
Je pense qu'il faut intégrer un jeu d'évènements pour les textbox également dans la classe, et ainsi exécuter la même procédure de colorisation des TB, si j'ai bien compris :
Option Explicit
Public WithEvents clsLbl As MSForms.Label
Public WithEvents cTB As MSForms.TextBox
Private Sub cTB_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
ColorisationTB cTB
End If
End Sub
Private Sub clsLbl_Click()
dim sNumb$
sNumb = Mid(clsLbl.Name, 6)
If WidgetExists("TextBox" & sNumb) Then ColorisationTB clsLbl.Parent.Controls("TextBox" & sNumb)
End Sub
private Sub ColorisationTB(TB as msforms.textbox)
With TB
.BackColor = IIf(.BackColor = &HC0E0FF, vbWhite, &HC0E0FF)
End With
end sub
Private Function WidgetExists(ByVal Name As String) As Boolean
On Error Resume Next
WidgetExists = Not clsLbl.Parent.Controls(Name) Is Nothing
On Error GoTo 0
End FunctionIci, le code d'affectation :
dim tCls() as new clsCtrl 'en tete de module à la place de la collection (classe renommée car TB également)
Private Sub SetClass()
Dim ctrl As Control, n&
For Each ctrl In Me.Controls
select case TypeName(ctrl)
case "Label": n = n + 1: redim preserve tCls(1 to n): Set tCls(n).clsLbl = ctrl
case "TextBox": n = n + 1: redim preserve tCls(1 to n): Set tCls(n).cTB = ctrl
end select
Next
End SubAttention, j'ai renommé la classe dans le code clsCtrl. Et j'ai enlevé la collection pour la remplacer par un tableau d'objets clsCtrl.
Cdlt,
Edit : Salut Bruno !
Bonjour Bruno, bonjour 3GB,
@3GB ta solution me semble la plus adaptée, mais juste en faisant un copier coller de ton code, sans rien y toucher, j'ai un message d'erreur en démarrant : "erreur de compilation : tableau attendu" avec "ReDim Preserve tCls(1 To" sélectionné par le débugueur dans le sub setclass.
Pourtant le tableau est sensé être déclaré plus haut en début de module avec Dim tCls As New clsCtrl n'est ce pas ?
Bonjour Arnaud,
Oui, c'est ça, normalement, il faut déclarer en tête du module d'Userform
Dim tCls() As New clsCtrl(en mettant bien les petites parenthèses) pour une classe nommée "ClsCtrl".
Il faut savoir que je suis revenu sur mon code hier soir et ai fait quelques petites corrections car j'avais oublié des petits détails, ayant saisi le code directement sur le forum.
A voir si le code actuel fonctionne.
Si ça ne compile toujours pas, peux-tu coller le code ici ?
Bonjour 3GB,
Merci beaucoup, ça compile !
Par contre je m'arrache les cheveux pour essayer de l'adapter à ma problématique : Comme le fichier est très lourd impossible de l'envoyer, et je n'arrive pas à l'alléger suffisemment en isolant le problème, tout en gardant le code fonctionnel... Donc j'essaye de décrire le problème j'espère que ça ira
J'ai un multipage avec une cinquante de textboxes dispatchées, avec à chaques fois des cases à cocher et surtout la textbox qui recueille les infos (par exemple "textbox12") et son libellé ("label12"), et en première page un résumé avec des textboxes alignées qui reprennent tout ("TextboxRésumeIntitulé1", "TextboxRésumeContenu1", "TextboxRésumeIntitulé2", "TextboxRésuméContenu2"... jusqu'à 47).
Les infos intéressantes sont mises en couleur dans le multipage, et sont automatiquement en couleur dans le résumé. Le but est de pouvoir les mettre en couleur aussi DEPUIS le résumé, avec un clic droit. Mais pour que ce soit sauvegardé, il faut qu'en faisant ça cela mette en lumière l'info aussi dans le multipage.
Et le problème est de trouver le bon textbox du multipage depuis le résumé.
La suite logique pour le trouver est la suivante : je clique sur TextboxRésuméContenu2, je regarde TextboxRésumeIntitulé2 texte correspond au label du multipage. Je vais donc chercher les controles du multipage dont le caption = TextboxRésumeIntitulé2.text (et là déjà je n'arrive pas avec select case, j'ai l'impression que ça ne marche pas dans le module de classe...bref
C'est cette suite logique que je n'arrive pas à coder dans le module de classe... Voici les codes que j'ai essayer de mettre en place sans succès :
'Option Explicit
Public WithEvents clsLbl As MSForms.Label
Public WithEvents cTB As MSForms.TextBox
Dim TmnClicTB As Boolean
Private Sub cTB_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim sNum As String
Dim ctrl As Control
If Button = 2 Then
If cTB.Locked = False Then 'si c'est une textbox où on écrit, pas une résumé, double évènement clic apparemment...d'où le boolean
If TmnClicTB = True Then
ColorisationTB cTB
End If
TmnClicTB = Not TmnClicTB
Else 'si c'est sur TextboxRésumé
If cTB.Text = "" Then
Exit Sub
Else
ColorisationTBResume cTB 'on met en lumière le contenu
sNum = Mid(cTB.Name, 21)
ColorisationTBResume cTB.Parent.Controls("TextboxRésumeIntitulé" & sNum) 'on met en lumière l'intitulé
For Each ctrl In UserformBilan.Controls
'et là il faudrait mettre en lumière dans les textboxes du multipage, car c'est ça qui sera enregistré à la validation...
On Error Resume Next
If ctrl.Caption = cTB.Parent.Controls("TextboxRésumeIntitulé" & sNum).Text Then 'donc on va cherche le label qui correspond au bon item
ColorisationTB cTB.Parent.Controls("TextBox" & Mid(ctrl.Name, 6)) 'de ce label (appelé "labelX") on va déduire le texbox correspondant du multipage (appelé "textboxX")
'Exit For
End If
On Error GoTo 0
Next
'le petit code ci dessous fonctionnait mais ne va pas car il ne choisira pas le bon textbox si plusieurs textbox ont le même contenu (par exemple : "aucun")...
' For Each ctrl In UserformBilan.Controls
' On Error Resume Next
' If ctrl.Locked = False And ctrl.Text = TxtRech Then
' On Error GoTo 0
' If cTB.Parent.Controls("TextboxRésuméIntitulé" & sNum).Text = ("label" & Mid(ctrl.Name, 7)).Caption Then
' ColorisationTB ctrl
'
' 'Exit For
' End If
' End If
' On Error GoTo 0
'
'
' Next
End If
End If
End If
End Sub
Private Sub clsLbl_Click()
Dim sNumb$
sNumb = Mid(clsLbl.Name, 6)
If WidgetExists("TextBox" & sNumb) Then ColorisationTB clsLbl.Parent.Controls("TextBox" & sNumb)
End Sub
Private Sub ColorisationTBResume(TB As MSForms.TextBox)
With TB
.ForeColor = IIf(.ForeColor = RGB(204, 85, 0), vbBlack, RGB(204, 85, 0))
.Font.Bold = IIf(.Font.Bold = True, False, True)
End With
End Sub
Private Sub ColorisationTB(TB As MSForms.TextBox)
With TB
.BackColor = IIf(.BackColor = &HC0E0FF, vbWhite, &HC0E0FF)
End With
End Sub
Private Function WidgetExists(ByVal Name As String) As Boolean
On Error Resume Next
WidgetExists = Not clsLbl.Parent.Controls(Name) Is Nothing
On Error GoTo 0
End FunctionEt ici le set class :
Private Sub SetClass()
Dim ctrl As Control, n&
For Each ctrl In Me.Controls
Select Case TypeName(ctrl)
Case "Label": n = n + 1: ReDim Preserve tCls(1 To n): Set tCls(n).clsLbl = ctrl
Case "TextBox"
If InStr(ctrl.Name, "TextboxRésumeContenu") <> 0 Then
n = n + 1: ReDim Preserve tCls(1 To n): Set tCls(n).cTB = ctrl
ElseIf ctrl.Name = "textbox7" Or ctrl.Name = "textbox8" Or ctrl.Name = "textbox9" Or ctrl.Name Like "textbox##" Then
n = n + 1: ReDim Preserve tCls(1 To n): Set tCls(n).cTB = ctrl
End If
End Select
Next
End SubMerci beaucoup si vous arrivez à me débloquer
Bonjour Arnnaud,
Tant mieux car de toute façon je n'ouvre pas les fichiers en règle générale...
Ce n'est pas évident pour de moi de comprendre comme ça, notamment la façon dont le résumé est alimenté, mais j'imagine qu'il y a un lien entre les TextboxRésume et les textbox##. Il faut savoir qu'il y a une propriété intéressante, la propriété .tag, qui permet de stocker une valeur, une information.
Ca pourrait être un moyen de créer un lien entre les TB du résumé et celles du multipage, par exemple en affectant au tag d'une TB du résumé le nom d'un TB du multipage.
Est-ce que la validation des données repose sur la mise en couleur ? J'ai l'impression d'avoir lu ça dans votre code.
@3GB, les textboxrésumé sont alimentées à la même source que les texbox## c'est à dire à la base de données qui est sur un classeur excel.
Et impossible d'utiliser les tag je m'en sers déjà pour autre chose
Non la validation des données ne repose pas sur la mise en couleur. Mais lorsqu'on valide les données on ne valide que le contenu du multipage, pas le résumé. Donc il faut mettre en couleur dans le contenu, si c'est que dans le résumé ça n'est pas enregistré...
Donc merci pour tes réflexions qui m'ont fait avancer
Je doute que ça puisse servir à quiconque mais sait-on jamais... Voici le code final du module de classe, avec du coup les textboxes qui lorsqu'elles se remplissent prennent comme tag le numéro de colonne de la cellule excel d'où elles tirent leur contenu.
'Option Explicit
Public WithEvents cTB As MSForms.TextBox
Dim TmnClicTB As Boolean
Private Sub cTB_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim sNum As String
Dim ctrl As Control
If Button = 2 Then
If cTB.Locked = False Then 'si c'est une textbox où on écrit, pas une résumé, double évènement clic apparemment...d'où le boolean
If TmnClicTB = True Then
ColorisationTB cTB
End If
TmnClicTB = Not TmnClicTB
Else 'si c'est sur TextboxRésumé
If cTB.Text = "" Then
Exit Sub
Else
ColorisationTBResume cTB 'on met en lumière le contenu
sNum = Mid(cTB.Name, 21)
ColorisationTBResume cTB.Parent.Controls("TextboxRésumeIntitulé" & sNum) 'on met en lumière l'intitulé
For Each ctrl In UserformBilan.Controls
On Error Resume Next
If ctrl.Tag = cTB.Tag Then
If ctrl.Name Like "TextboxRésume*" Then
Else
ColorisationTB ctrl
Exit For
End If
End If
On Error GoTo 0
Next
End If
End If
End If
End Sub
Private Sub ColorisationTBResume(TB As MSForms.TextBox)
With TB
.ForeColor = IIf(.ForeColor = RGB(204, 85, 0), vbBlack, RGB(204, 85, 0))
.Font.Bold = IIf(.Font.Bold = True, False, True)
End With
End Sub
Private Sub ColorisationTB(TB As MSForms.TextBox)
With TB
.BackColor = IIf(.BackColor = &HC0E0FF, vbWhite, &HC0E0FF)
End With
End SubMerci
Salut Arnnaud,
Tant mieux, je suis content que ça marche.
Pour moi, la seule difficulté était de faire le lien entre les 2 sortes de TB mais s'il est fait, c'est parfait.
Si j'étais toi, je prendrais plutôt le nom des colonnes (j'imagine que les données proviennent d'un tableau structuré) plutôt que la position.
Au cas où, si tu étais bloqué par la propriété .tag déjà utilisée pour autre chose, il est toujours possible d'en créer une au niveau de la classe :
Public WithEvents clsLbl As MSForms.Label
Public WithEvents cTB As MSForms.TextBox
private pTag as variant
Public property get Tag() as variant 'propriété Tag en lecture
Tag = pTag
end property
public property let Tag(mTag as Variant) 'propriété Tag en écriture
pTag = mTag
end property
'reste du code avec les evenementsCelle-ci peut-être utilisée ainsi, en écriture notamment lors de l'affectation, et en lecture pour l'exemple :
Private Sub SetClass()
Dim ctrl As Control, n&
For Each ctrl In Me.Controls
Select Case TypeName(ctrl)
Case "Label": n = n + 1: ReDim Preserve tCls(1 To n): Set tCls(n).clsLbl = ctrl
Case "TextBox"
If ctrl.Name like "TextboxRésumeContenu*" Then
n = n + 1: ReDim Preserve tCls(1 To n): Set tCls(n).cTB = ctrl: tCls(n).tag = "Coucou" & n 'écriture
debug.print tCls(n).tag 'lecture dans la fenetre d'exécution
ElseIf ctrl.Name = "textbox[7-9]" Or ctrl.Name Like "textbox##" Then
n = n + 1: ReDim Preserve tCls(1 To n): Set tCls(n).cTB = ctrl
End If
End Select
Next
End SubDans la classe, cette propriété s'utilise directement ainsi :
If ctrl.Tag = Me.Tag Then
'suite du codeOn a appelé la propriété Tag mais on aurait pu l'appeler Name aussi...
Aussi, il est possible de définir différentes sortes de TB :
Public WithEvents cTB As MSForms.TextBox
Public WithEvents cTBResume As MSForms.TextBoxchaque sorte de TB ayant ses évènements (et bien sûr son affectation propre : set tCls(n).cTBResume = ctrl ou set tCls(n).cTB = ctrl)
J'espère en tout cas que tu pourras bien avancer dans ton projet.
Merci d'être revenu poster ton code ici.
Bonne soirée,
Merci pour ces partages de réflexions et de codes exemples qui m'aident à mieux comprendre les bonnes pratiques, et merci pour les encouragements :-)
Bonne soirée A+