Segue duas macros diferentes que geram o menu suspenso, e no fim da página o link para download da planilha pronta.
 |
| Menu Suspenso/ Menu PopUp |
Sub Jogos()
Application.CommandBars("Cell").Reset
Dim cbc As CommandBarControl
'Oculta todos os comandos do botão direito
For Each cbc In Application.CommandBars("cell").Controls
cbc.Visible = False
Next cbc
'Adiciona um sub menu com o nome cartas
Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup).Caption = "Tabuleiro"
With Application.CommandBars("Cell").Controls("&Tabuleiro")
'Adiciona um sub menu com o nome xadrez
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 217
.Caption = "Xadrez"
.OnAction = "Xadrez"
End With
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 150
.Caption = "damas"
.OnAction = "damas"
End With
End With
Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup).Caption = "Eletronicos"
With Application.CommandBars("Cell").Controls("Eletronicos")
.BeginGroup = True
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 59
.Caption = "Vídeo Game"
.OnAction = "Vídeo_Game"
End With
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 574
.Caption = "Android"
.OnAction = "Android"
End With
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 69
.Caption = "&Windows"
.OnAction = "Windows"
End With
End With
Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup).Caption = "Cartas"
With Application.CommandBars("Cell").Controls("&Cartas")
With .Controls.Add(Type:=msoControlPopup)
.Caption = "&Pretas"
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 483
.Caption = "Espadas"
.OnAction = "Espadas"
End With
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 484
.Caption = "Paus"
.OnAction = "Paus"
End With
End With
' No submenu cartas adiciona o submenu vermelhas
With .Controls.Add(Type:=msoControlPopup)
.Caption = "&Vermelhas"
' No submenu vermelhas adiciona o submenu menor que 5
With .Controls.Add(Type:=msoControlPopup)
.Caption = "Menor que 5"
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 481
.Caption = "Copas"
.OnAction = "Copasmenor"
End With
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 482
.Caption = "Ouro"
.OnAction = "Ouromenor"
End With
End With
With .Controls.Add(Type:=msoControlPopup)
.Caption = "Maior que 5"
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 481
.Caption = "Copas"
.OnAction = "Copasmaior"
End With
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 482
.Caption = "Ouro"
.OnAction = "Ouromaior"
End With
End With
End With
End With
'mostra o menu
Application.CommandBars("Cell").ShowPopup
'reset do menu
Application.CommandBars("Cell").Reset
For Each cbc In Application.CommandBars("cell").Controls
cbc.Visible = True
Next cbc
End Sub
Sub Xadrez()
MsgBox "Você escolheu Xadrez ", , "Jogos"
End Sub
Sub damas()
MsgBox "Você escolheu damas ", , "Jogos"
End Sub
Sub Vídeo_Game()
MsgBox "Você escolheu Tablet ", , "Jogos"
End Sub
Sub Android()
MsgBox "Você escolheu Android ", , "Jogos"
End Sub
Sub Windows()
MsgBox "Você escolheu Windows ", , "Jogos"
End Sub
Sub Espadas()
MsgBox "Você escolheu Espadas ", , "Jogos"
End Sub
Sub Paus()
MsgBox "Você escolheu Paus ", , "Jogos"
End Sub
Sub Copasmenor()
MsgBox "Você escolheu Copas menor do que 5 ", , "Jogos"
End Sub
Sub Ouromenor()
MsgBox "Você escolheu Ouro menor do que 5 ", , "Jogos"
End Sub
Sub Copasmaior()
MsgBox "Você escolheu Copas maior do que 5 ", , "Jogos"
End Sub
Sub Ouromaior()
MsgBox "Você escolheu Ouro maior do que 5 ", , "Jogos"
End Sub
---------------------------------------------------------------------------------------------------------------
Sub MenuSuspenso()
Application.CommandBars("Cell").Reset
Dim cbc As CommandBarControl
'Oculta todos os comandos do botão direito
For Each cbc In Application.CommandBars("cell").Controls
cbc.Visible = False
Next cbc
'Adiciona um comando ao menu suspenso
With Application.CommandBars("Cell").Controls.Add(Temporary:=True)
.Caption = "Word"
.OnAction = "Word"
.FaceId = 42
End With
With Application.CommandBars("Cell").Controls.Add(Temporary:=True)
.Caption = "Acces"
.OnAction = "Acces"
.FaceId = 264
End With
'Adiciona um comando ao menu suspenso
With Application.CommandBars("Cell").Controls.Add(Temporary:=True)
.Caption = "Excel"
.OnAction = "Excel1"
.FaceId = 263
End With
'mostra o menu
Application.CommandBars("Cell").ShowPopup
'reset do menu
Application.CommandBars("Cell").Reset
For Each cbc In Application.CommandBars("cell").Controls
cbc.Visible = True
Next cbc
End Sub
Sub Word()
MsgBox "Voce selecionou Word ", , "MS Office''"
End Sub
Sub Acces()
MsgBox "Voce selecionou Acces ", , "MS Office''"
Sub Excel1()
MsgBox "Voce selecionou Excel ", , "MS Office''"
End Sub
End Sub
Veja a Vídeo Aula
Baixar planilha
Caso nenhum dos links funcionem, solicite por e-mail: atualexcel@gmail.com
