Comment placer le nom d'une sub (ou d'une case d'option) dans une variable

Version imprimable

22/07/2019, 12h06
Henri1830

Comment placer le nom d'une sub (ou d'une case d'option) dans une variable
Bonjour à tous,

Voici ma problématique.
Il s'agit d'une feuille Excel contenant des dizaines de cases d'option, check box, etc...

Chacune de ses cases d'option génère une macro qui commence toutes par le nom de la case d'option. Exemple :

Code:

Private Sub NomDeLaCaseD'Option_Click()

J'ai besoin de ce nom par la suite pour connaître l'emplacement de la case d'option avec l'instruction

Code:

ActiveSheet.Shapes("NomDeLaCaseD'Option").TopLeftCell.Row

Pour me faciliter la vie, j'aimerais récupérer le nom de la macro (ou de la case d'option courante) dans une variable, afin de pouvoir utiliser toujours la même instruction dans toutes les petites sub associées aux cases d'option.

cela donnerait donc quelque chose comme ceci :
Code:

1 2 3 Private Sub NomDeLaCaseD'Option_Click() Var = MID(sub.name,1,LEN(sub.name-6) ' ou idem avec case d'option.name ActiveSheet.Shapes(Var).TopLeftCell.Row
Quelqu'un pourrait-il me communiquer l'instruction adéquate ?

Merci d'avance et bonne journée.

Henri
22/07/2019, 12h24
Menhir

Le plus simple est d'utiliser la propriété Application.Caller qui renvoie le nom de l'élément qui a appelé la macro :
https://docs.microsoft.com/fr-fr/off...ication.caller

re
bonjour
tu a deux solutions
soit tu extériorise le code du opttionbuttion dans une sub avec argument
soit tu crée un module classe pour mapper tes optionbutton

pour l'exteriorisation du code pour réutilisation avec x controls identiques

exemple 'dans le module de la feuille
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub OptionButton1_Click() optionbuttons_click OptionButton1 End Sub ' Private Sub OptionButton2_Click() optionbuttons_click OptionButton2 End Sub ' ' Sub optionbuttons_click(opt) MsgBox ActiveSheet.Shapes(opt.Name).TopLeftCell.Address End Sub
la sub optionbuttons_click peut etre dans un module standard

22/07/2019, 12h50
Henri1830
Citation:

Envoyé par Menhir

Mille mercis pour ta réponse, Menhir. Voici ce que j'ai fait
Code:

1 2 3 Private Sub Contingent_Click() ' Tableau Student test = Application.Caller
ce qui abouti à l'erreur 2023. Un idée de ce qui serait erroné ?

Citation:

Envoyé par patricktoulon

Bonjour Patrick,

Merci pour ta réponse. Voici ce que j'ai fait :
Code:

1 2 3 Sub optionbuttons_click(opt) MsgBox ActiveSheet.Shapes(opt.Name).TopLeftCell.Address End Sub
que j'appelle de cette manière-ci:
Code:

1 2 Private Sub Contingent_Click() ' Tableau Student Call optionbuttons_click(opt)
Malheureusement, cela abouti à l'erreur d'exécution 424 - objet requis
Une idée de ce qui est erroné ?
22/07/2019, 13h02
patricktoulon

re

re
c'est sur que si tu suit pas exactement ce qui t'est montré ca buggera

Code:

Call optionbuttons_click(Contingent)
22/07/2019, 13h14
Henri1830

Malheureusement, ta solution ne résout pas mon problème. En effet, elle me contraint de retaper le nom de la macro (ou de la case d'option, ce qui revient du pareil au même) et c'est précisément ce que je souhaite éviter.

Une autre idée peut-être ? C'est une solution dans le genre de ce que Menhir m'a proposé qui est l'idéal, mais cela me retourne un code d'erreur et je ne vois pas pourquoi.
22/07/2019, 13h30
Menhir
Citation:

Envoyé par Henri1830

ce qui abouti à l'erreur 2023. Un idée de ce qui serait erroné ?

Quel est le message de l'erreur ?

Sans certitude, je pense que le problème vient de la variable.
Essaye ça :
Code:

1 2 3 Private Sub Contingent_Click() ' Tableau Student Debug.Print Application.Caller End Sub
Et regarde ce que ça renvoie dans la fenêtre d'exécution.
22/07/2019, 14h03
Henri1830

La seule chose qui s'affiche est Erreur 2023
Si je cherche sur Internet, je retrouve rien qui m'aide...
22/07/2019, 14h23
patricktoulon
Citation:
Envoyé par Henri1830

La seule chose qui s'affiche est Erreur 2023
Si je cherche sur Internet, je retrouve rien qui m'aide

Code:

1 2 3 Private Sub Contingent_Click() ' Tableau Student Debug.Print Application.Caller End Sub

...
essaie de raisonner logiquement
comment veux tu que application.caller te donne quelque chose alors que l'évènement est en train de se produire et donc le (Click) est déclaré" effectif quand tu lache le bouton de la souris

d'autant plus que
comment veux tu que le application.caller te ramène quelque chose alors qu'il n'y a aucun caller dans l'évènement
puisqu'il est en train de se produire et que application.caller inself n'existe pas :mouarf:

ca oui ca fonctionnera
Code:

1 2 3 4 5 6 7 Private Sub Contingent_Click() ' Tableau Student optionbuttons_click End Sub sub optionbuttons_click() msgbox application.caller end sub
22/07/2019, 14h57
Henri1830

Cher Patrick,

Désolé de te décevoir, mais ta proposition abouti à la même erreur que celle de Menhir : Erreur 2023...

A titre de commentaire, je trouve quand même curieux qu'on ne puisse déterminer le nom de la case d'option sur laquelle on vient de cliquer et/ou de connaître le nom de la macro qui est en train de tourner. Par définition, VBA doit savoir où il est pour exécuter ce qu'on lui demande....

re
et oui mince
j'oubliais

si tu a l'évènement c'est que ce sont des control ActivX et donc on a aucun control sur le caller a part comme je t'ai montré au début en injectant le control en argument
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub OptionButton1_Click() optionbuttons_click OptionButton1 End Sub ' Private Sub OptionButton2_Click() optionbuttons_click OptionButton2 End Sub ' ' Sub optionbuttons_click(opt As msforms.OptionButton) MsgBox Shapes(opt.Name).TopLeftCell.Address End Sub

22/07/2019, 15h35
Henri1830

Bon ben si je comprends bien, il n'y a pas de solution à ma demande...
Si quelqu'un d'autre trouve une solution, il sera le bienvenu.
Merci à Menhir et Patrick pour leur collaboration.

Bonne journée à tous !

Henri

1 pièce(s) jointe(s)

re
si il y a une solution comme je te l'ai dit c'est soit une sub argumenté soit un module classe
exemple vite fait a main levées

dans un module standard

Code:

1
2
3
4
5
6
7
8
9
Dim cl As New classoption
Sub classement()
    For Each obj In Sheets(1).OLEObjects
        If TypeName(obj.Object) = "OptionButton" Then
            'MsgBox obj.Name
            cl.Adding obj
        End If
    Next
End Sub

et DANS UN MODULE CLASSE QUE TU NOMMERA "classoption"

Code:

1
2
3
4
5
6
7
8
9
Public WithEvents opt As MSForms.OptionButton
Public index As Long
Dim cls() As New classoption
Function Adding(obj)
    index = index + 1: ReDim Preserve cls(0 To index): Set cls(index).opt = obj.Object
End Function
Private Sub Opt_Click()
MsgBox opt.TopLeftCell.Address
End Sub

demo
Pièce jointe 492795

22/07/2019, 16h58
Philippe Tulliez
Bonjour,
Si ce sont des ActiveX et que tu veux connaître le nom du contrôle, voici quelques exemples
Les informations affichées par un MsgBox avec en titres la propriété Caption des contrôles et en Prompt la propriété Name

Pour un contrôle CommandButton
Code:

1 2 3 4 5 Private Sub CommandButton1_Click() With CommandButton1 MsgBox .Name, vbInformation, .Caption End With End Sub
Pour un contrôle CheckBox nommé CheckBox1
Code:

1 2 3 4 5 Private Sub CheckBox1_Click() With CheckBox1 MsgBox .Name, vbInformation, .Caption End With End Sub
Pour un OptionButton nommé optFemale du groupe Sex (avec en plus les propriétés GroupName et Value dans le Prompt)
Code:

1 2 3 4 5 Private Sub optFemale_Click() With optFemale MsgBox .Name & " - " & .GroupName & " / " & .Value, vbInformation, .Caption End With End Sub
24/05/2020, 22h29
Pierre_PP

Merci

Cette discussion tombe à pic et je vous remercie tous car la solution de patricktoulon (création d'une classe) correspond exactement à mon problème (éxécuter une procédure lors d'un clic sur n'importe lequel des "ToggleButton" de ma feuille en passant son nom en argument) !

Précisions

Bonsoir à tous,

En utilisant le code de patricktoulon j'ai pas mal galéré car j'ai essayé de passer mon "togglebutton" en argument de la fonction "click" :

Module de classe

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
Public WithEvents tog As MSForms.ToggleButton
Public index As Long
Dim cls() As New classtoggle
Function Adding(obj)
    index = index + 1: ReDim Preserve cls(0 To index): Set cls(index).tog = obj.Object
End Function
Private Sub Tog_Click()
 
    Fonctions.BT_Cl (tog.Object)
 
End Sub

Module "Fonctions"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Dim cl As New classtoggle

Sub Declaration()
    For Each obj In Sheets("Hacheur").OLEObjects
        If TypeName(obj.Object) = "ToggleButton" Then
            cl.Adding obj
        End If
    Next
End Sub

Sub BT_Cl(BT As MSForms.ToggleButton)
    
    With BT
        If .Value = True Then
            .BackColor = RGB(0, 255, 0) 'Vert
            Fonctions.Coloriage Right(BT.Name, 2), RGB(0, 255, 0)
        ElseIf .Value = False Then
            .BackColor = RGB(240, 240, 240) 'Gris
            Fonctions.Coloriage Right(BT.Name, 2), RGB(0, 0, 0)
        End If
    End With

End Sub

En arrivant à la ligne soulignée, Excel se fermait directement sans renvoyer aucune erreur ! Si quelqu'un sais me dire pourquoi ça m'intéresse... Je ne comprend pas bien également pourquoi dans le module de classe (cl) on déclarait un nouveau module de cette même classe (cls) ?

J'ai donc simplifié la classe et trouvé une solution pour faire ce que je voulais. Je ne sais pas si ça intéressera quelqu'un mais voila ce que j'ai fait pour que ça marche :

Module de classe

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Public WithEvents tog As MSForms.ToggleButton
Public index As Integer
 
Function Adding(obj)
    Set cl(nb_tog).tog = obj.Object
    cl(nb_tog).index = nb_tog
End Function
Private Sub Tog_Click()
 
    Fonctions.BT_Click (Me.index)
 
End Sub

Module "Fonctions"

Code:

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
 
Public cl() As New classtoggle
Public nb_tog As Long
 
Sub Declaration()
 
    nb_tog = 0
 
    For Each obj In Sheets("Hacheur").OLEObjects
        If TypeName(obj.Object) = "ToggleButton" Then
            nb_tog = nb_tog + 1
            ReDim Preserve cl(1 To nb_tog)
            cl(nb_tog).Adding obj
        End If
    Next
 
End Sub
 
Sub BT_Click(id_tog As Integer)
 
    Dim BT As MSForms.ToggleButton
    Set BT = cl(id_tog).tog
 
    With BT
        If .Value = True Then
            .BackColor = RGB(0, 255, 0) 'Vert
            Fonctions.Coloriage Right(BT.Name, 2), RGB(0, 255, 0)
        ElseIf .Value = False Then
            .BackColor = RGB(240, 240, 240) 'Gris
            Fonctions.Coloriage Right(BT.Name, 2), RGB(0, 0, 0)
        End If
    End With
 
End Sub

Je n'arrive toujours pas à passer directement le "togglebutton" en paramètre de la fonction mais en passant par le numéro d'index ça marche...

En tout cas merci encore de m'avoir mis sur la voie sinon je pense que j'y serais encore !

Pierre