Popup - Activer une cellule depuis le onAction
Bonjour,
je souhaiterais, en cliquant sur le bouton droit de la souris, faire apparaître un menu et en cliquant sur un item du menu, aciver une cellule d'une feulle de mon classeur.
Pas de problème, pour le menu et la création de la procédure. Si je mets un MsgBox dans ma procédure goToCellule, le message s'affiche. Par contre, je n'arrive pas à déplacer le curseur sur une cellule quelconque de ma feuille.
Quelqu'un aurait une idée?
Merci
RaoulPierre
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 = BuildProcArgString("goToCellule", "6", "6")
End With
Set CreateMyOwnSubMenu = menubar
Set menubar = Nothing
End Function
Function BuildProcArgString(ByVal ProcName As String, ParamArray Args() As Variant)
Dim TempArg
Dim Temp
For Each TempArg In Args
Temp = Temp + Chr(34) + TempArg + Chr(34) + ","
Next
BuildProcArgString = ProcName + "(" + Left(Temp, Len(Temp) - 1) + ")"
End Function
Sub goToCellule(xStr As String, yStr As String)
Dim objWorksheet As Excel.Worksheet
Set objWorksheet = ThisWorkbook.Sheets("Feuil1")
objWorksheet.Cells(6, 7).Activate
End Sub
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.
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