Menu Suspenso - Drop Down - VBA

[Leandro SSS]

Boa tarde pessoal,

Estava pesquisando na net a opção de acrescentar menu no excel para um relatório que estava desenvolvendo em questão.

Acabei achando uma maneira de acrescentar um menu drop down parecido com a opção de botão direito.

Vou tentar explicar como é possivel fazer o menu, quem sabe possa ajudar alguém:

Obs:

1. fiz este teste no office 2007, não sei se é possivel fazer o mesmo em versões anterior.

2. sou newbie em vba e só estou postando pois isso talvez possa ajudar alguém enquanto tb me ajuda.

Simbora...

1. Abra o Excel

2. Aperte Alt F11 para abrir o Editor de VBA.

3. Na nova janela que abrir insira um novo módulo indo no menu "Inserir" e depois em "Módulo"

4. Renomeio o módulo de "Módulo1" para "Menu" (apenas para identificação) [é só alterar a propriedade NAME com o módulo recem criado selecionado]

5. Adicione o seguinte código abaixo na janela de código a direita que apareceu após ter criado o módulo:

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 = "Minha Macro 1"

.OnAction = "Test1"

End With

'Adiciona um comando ao menu suspenso

With Application.CommandBars("Cell").Controls.Add(temporary:=True)

.Caption = "Minha Macro 2"

.OnAction = "Test2"

End With

'Adiciona um comando ao menu suspenso

With Application.CommandBars("Cell").Controls.Add(temporary:=True)

.Caption = "Minha Macro 3"

.OnAction = "Test3"

.FaceId = 29

'BeginGroup coloca uma linha azul para separar o item

.BeginGroup = True

End With

'Submenu com três itens

Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup).Caption = "Sub&Menu"

With Application.CommandBars("Cell").Controls("SubMenu")

x = "Sub Item &1"

.Controls.Add(Type:=msoControlButton).Caption = x

.Controls(x).OnAction = "Test1"

x = "Sub Item &2"

.Controls.Add(Type:=msoControlButton).Caption = x

.Controls(x).OnAction = "Test2"

x = "Sub Item &3"

.Controls.Add(Type:=msoControlButton).Caption = x

.Controls(x).OnAction = "Test3"

End With

Application.CommandBars("Cell").ShowPopup

End Sub

Sub Test1()

MsgBox "Macro de Teste 1", , "Item de menu ''Macro 1''"

End Sub

Sub Test2()

MsgBox "Macro de Teste 2", , "Item de menu ''Macro 2''"

End Sub

Sub Test3()

MsgBox "Macro de Teste 3", , "Item de menu ''Macro 3''"

End Sub

6. Feche o editor de VBA em "Arquivo" e "Fechar e voltar para Microsoft Excel"

7. Adicione um botão de Formulário ou pode ser um Retangulo das Formas do Excel.

8. Clique com o botão direito do mouse no botão ou forma que acabou de criar e escolha a opção: Atribuir Macro.

9. Na nova janela, escolha a opção "MenuSuspenso" e clique em Ok.

10. Em seguida é só clicar com o botão esquerdo do mouse em seu novo botão que o menu irá aparecer.

DICAS

Para acrescentar uma imagem ao lado do item do menu, é necessário utilizar o comando ".FaceId = x" no bloco do item que deseja que apareça a imagem onde x representa um número de 1 a 4000 e cada número representa uma imagem.

Para acrescentar uma linha para dividir grupos, utilize o comando ".BeginGroup = True" no bloco do primeiro item que deseja que apareça o divisor acima.

Vou tentar postar aqui um link com a planilha pronta mas não sei se irá, se não é permitido peço desculpa aos moderadores:

http://www.fileupyou...nuSuspenso.xlsm