onAction - instructions non exécutées

Version imprimable

02/04/2012, 10h56
RaoulPierre

onAction - instructions non exécutées
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:

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
02/04/2012, 11h15
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:

objWorksheet.Select

avant :

Code:

objWorksheet.Cells(6, 7).Activate

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

La totalité de mon code est

Au niveau du workbook

Code:

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

Au niveau du module

Code:

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:

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:

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:

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

Une solution ...

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:

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