Discussion :

[RaoulPierre]

Bonjour,

je souhaiterais, en cliquant avec le bouton droit de la souris, faire apparaître un popup et, en sélectionnant un item du menu, me déplacer vers une cellule.

Pour le popup, pas de problème.
Le clic sur l'item se passe correctement puisque lorsque je demande à la procédure appelée d'afficher un MsgBox, le message apparait. Par contre, les instructions

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    Dim objWorksheet As Excel.Worksheet
    Set objWorksheet = ThisWorkbook.Sheets("Feuil1")
    objWorksheet.Cells(6, 7).Activate

ne s'exécutent pas et de manière générale, je n'arrive pas à appeler une procédure ou une fonction quelconque de ma feuille.
Par contre, les mêmes instructions s'exécutent correctement si je les place directement dans le code du module et pas dans la procédure appelée sur le onAction!

Une idée?

Merci

Raoul

[Daniel.C]

Bonjour,

Tu veux dire que tu modifies le menu contextuel du bouton ? Publies la totalité de ton code. D'une manière générale, tu devrais mettre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

objWorksheet.Select

avant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

objWorksheet.Cells(6, 7).Activate

[RaoulPierre]

Merci pour la réponse.
Il semble cependant que cela ne suffise pas!

La totalité de mon code est

Au niveau du workbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub Workbook_Open()
    Set cb_Menu = CreateMyOwnSubMenu()
    Call SetupAllWSEvents
End Sub

Au niveau du module

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
Option Explicit
Global cb_Menu As CommandBar
Global cb_Red As CommandBar
Global cb_Yellow As CommandBar
Global cb_Green As CommandBar
Global WSObj As Collection
Global ws As Worksheet
 
Sub SetupAllWSEvents()
 
    Dim WSo As clsWS
    Set WSObj = Nothing
    Set WSObj = New Collection
    For Each ws In ActiveWorkbook.Worksheets
        Set WSo = New clsWS
        Set WSo.WSToMonitor = ws
        WSObj.Add WSo, ws.Name
    Next ws
 
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
Function CreateMyOwnSubMenu() As CommandBar
    Dim menubar As CommandBar
   Dim newMenu As CommandBarControl
 
    'remove previous instance
    Call DeleteCommandBar("myOwnSubMenu")
    'Add our popup menu to the CommandBars collection
    Set menubar = CommandBars.Add(Name:="myOwnSubMenu", _
        Position:=msoBarPopup, _
        menubar:=False, _
        Temporary:=False)
 
      Set newMenu = menubar.Controls.Add(Type:=msoControlPopup)
    With newMenu
        .Caption = "&Salon"
        .OnAction = "goToCellule"
    End With
 
    Set CreateMyOwnSubMenu = menubar
    Set menubar = Nothing
 
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub goToCellule()
    Dim objWorksheet As Excel.Worksheet
    Set objWorksheet = ThisWorkbook.Sheets("Feuil1")
    objWorksheet.Select
    objWorksheet.Cells(6, 7).Activate
End Sub

Au niveau de la classe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Dim WithEvents aWS As Worksheet
 
Property Set WSToMonitor(uWS As Worksheet)
    Set aWS = uWS
End Property
 
Private Sub aWS_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    cb_Menu.ShowPopup
End Sub

Merci

Raoul

[RaoulPierre]

J'ai fini par touver une solution en ne passant qu'un paramètre à la fonction. Je ne sais pourquoi mais il semble que l'erreur se situait à ce niveau.

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
Option Explicit
Global cb_Menu As CommandBar
Global WSObj As Collection
Global ws As Worksheet
 
Sub SetupAllWSEvents()
 
    Dim WSo As ClsWS
    Set WSObj = Nothing
    Set WSObj = New Collection
    For Each ws In ActiveWorkbook.Worksheets
        Set WSo = New ClsWS
        Set WSo.WSToMonitor = ws
        WSObj.Add WSo, ws.Name
    Next ws
 
End Sub
 
 
Function CreateMyOwnSubMenu() As CommandBar
    Dim menubar As CommandBar
    Dim menuItem As CommandBarControl
    Dim subMenuItem As CommandBarControl
    'remove previous instance
    Call DeleteCommandBar("myOwnSubMenu")
    'Add our popup menu to the CommandBars collection
    Set menubar = CommandBars.Add(Name:="myOwnSubMenu", _
        Position:=msoBarPopup, _
        menubar:=False, _
        Temporary:=False)
 
        Set menuItem = menubar.Controls.Add(Type:=msoControlPopup)
        Call AddMenu(menuItem, "Séjour", "Séjour1")
 
 
 
    Set CreateMyOwnSubMenu = menubar
    Set menubar = Nothing
 
End Function
 
Sub AddMenu(newMenu As CommandBarControl, titre As String, reference As String)
    With newMenu
        .Caption = "&" & titre
        .OnAction = "'" + "goToCelluleX " + """" + reference + """" + "'"
    End With
End Sub
 
 
 
 
Sub goToCelluleX(xStr As String)
    Dim objWorksheet As Excel.Worksheet
    Set objWorksheet = ThisWorkbook.Sheets("EtatdesLieux")
    objWorksheet.Range(xStr).Activate
End Sub