Cabeçalho

domingo, 29 de março de 2015

Barra de menus personalizada excel VBA

Olá, esta postagem exemplifica a criação de uma barra de menus personalizada no excel com VBA.
Exemplificarei três formas diferentes de barras de menus.




Exemplo 01.

Neste Exemplo construí um menu do tipo ComboBox, que pelo qual, é possível navegar entre as abas da planilha ou selecionar item de uma lista disponível no excel. Segue a macro pronta.


Sub Exemplo1()
On Error Resume Next
CommandBars("Barra_Planilhas").Delete    'Deleta a barra
'Cria a barra e defiene os nomes
Set MinhaBarra1 = CommandBars.Add
MinhaBarra1.Name = "Barra_Planilhas"
MinhaBarra1.Visible = True
Set menu = MinhaBarra1.Controls.Add(msoControlComboBox) 'Defiene o tipo de menu
For i = 1 To Sheets.Count    ' Faz a contagem das planilhas e adiciona ao ComboBox
    menu.AddItem Sheets(i).Name
Next
menu.OnAction = "Navega_Plan"   'Macro que ira executar ao clicar em uma opção
menu.Text = "Seleciona Planilha"  'Texto a exibir no combobox
Set menu2 = MinhaBarra1.Controls.Add(msoControlComboBox)
Dim x As String
i = Range(Cells(1, 1), Cells(10, 1))
For i = 1 To (Cells(Rows.Count, 1).End(xlUp).Row)
x = Plan2.Cells(i, 1)
menu2.AddItem (x)
Next
menu2.OnAction = "Navega_Plan1"
menu2.Text = "Menu 2"

End Sub
Sub Navega_Plan()
Sheets(CommandBars("Barra_Planilhas").Controls(1).Text).Select
End Sub
Sub Navega_Plan1()
Dim y As String
y = (CommandBars("Barra_Planilhas").Controls(2).Text)   'Transfere o item do menu2 selecionado para avariavel Y.
MsgBox (y)
End Sub
Sub RemoveBarra()
On Error Resume Next
    CommandBars("Barra_Planilhas").Delete
End Sub



Exemplo 02.

Este exemplo cria uma barra de menus com botões de comando (ControlButton)

Public Const MinhaBarra As String = "MinhaBarra"
Public Sub Exemplo2()
Dim Vbarra As CommandBar
Dim VBotoes As CommandBarButton
Dim menu As CommandBarPopup
    On Error Resume Next
    'Exclui a barra
    Application.CommandBars(MinhaBarra).Delete
   
    'Adiciona a barra de ferramentas com o nome de VBarra
    Set Vbarra = CommandBars.Add(MinhaBarra, msoBarFloating)
       
    With Vbarra
        .Visible = True
    End With
   
    'Adiciona botões à barra de ferramentas
    Set VBotoes = Vbarra.Controls.Add(Type:=msoControlButton)
        With VBotoes
            .BeginGroup = True
            .Caption = "Botão 1"            'Define o título do botão
            .Style = msoButtonCaption       'Estilo do botão (texto, icone, ambos ...)
            .OnAction = "macro1"            'Macro que executada ao clicar
            .Visible = True                 'Exibe ou oculta a barra
            .Width = 390                    'Define o tamanho do botão
            .TooltipText = "Este é o botão 1"  'Define o texto de informação do botão
        End With
       
    Set VBotoes = Vbarra.Controls.Add(Type:=msoControlButton)
        With VBotoes
            .Caption = "&Botão 2"
            .Style = msoButtonIconAndCaption
            .FaceId = 444
            .OnAction = "macro2"
            .Visible = True
            .Width = 200
        End With
       
        Set VBotoes = Vbarra.Controls.Add(Type:=msoControlButton)
        With VBotoes
            .Caption = "Botão 3"
            .Style = msoIcon
            .FaceId = 17
            .OnAction = "macro3"
            .Visible = True
            .Width = 50
        End With
       
        'Adiciona menus com figuras personalizadas
        Set VBotoes = Vbarra.Controls.Add(Type:=msoControlButton)
        With VBotoes
        .Caption = "&Botão 4"
        .Style = msoButtonIconAndCaption
        .OnAction = "macro4"
         Plan2.Shapes("imagem1").Copy
        .PasteFace
        .TooltipText = "Este é o botão 4"
    End With
       
        Set VBotoes = Vbarra.Controls.Add(Type:=msoControlButton)
        With VBotoes
        .Caption = "&Botão 5"
        .Style = msoButtonIconAndCaption
        .OnAction = "macro5"
         Plan2.Shapes("imagem2").Copy
        .PasteFace
    End With
End Sub
Public Sub DeletarBarra()
On Error Resume Next
    Application.CommandBars(MinhaBarra).Delete
End Sub
Sub macro1()
    MsgBox ("Você clicou no botão 1")
End Sub
Sub macro2()
    MsgBox ("Você clicou no botão 2")
End Sub
Sub macro3()
    MsgBox ("Você clicou no botão 3")
End Sub
Sub macro4()
    MsgBox ("Você clicou no botão 4")
End Sub
Sub macro5()
    MsgBox ("Você clicou no botão 5")
End Sub


Exemplo 03

Este exemplo cria um menu do tipo ControlPopup com sub menus.


Option Explicit
Sub Exemplo3()
Dim MeuMenu, MeuSubMenu As CommandBarControl
On Error Resume Next
    CommandBars.FindControl(Tag:="MeusMenus").Delete
      
    ' cria um novo menu
    Set MeuMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
    With MeuMenu
        .Caption = "&Meu Menu"
        .Tag = "MeusMenus"
        .BeginGroup = True
        .Visible = True
    End With
   
    If MeuMenu Is Nothing Then Exit Sub

    With MeuMenu.Controls.Add(msoControlButton, 1, , , True)
        .FaceId = 71
        .Caption = "&Menu Item1"
        .OnAction = "primeiramacro"
    End With

   
    With MeuMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "M&enu Item2"
        .OnAction = "segundamacro"
    End With
    With MeuMenu.Controls.Add(msoControlButton, 1, , , True)
        .FaceId = 59
        .Caption = "Menu Item 3"
        .OnAction = "terceiramacro"
    End With

    ' adiciona um menu
    Set MeuSubMenu = MeuMenu.Controls.Add(msoControlPopup, 1, , , True)
    With MeuSubMenu
        .Caption = "&Menu Item 4"
        .BeginGroup = False
    End With
    With MeuSubMenu.Controls.Add(Type:=msoControlPopup)
            .Caption = "&SubMenuItem"
           
            With .Controls.Add(Type:=msoControlPopup)
            .Caption = "SubItem 1"
                With .CommandBar.Controls.Add(Type:=msoControlButton)
                    .FaceId = 71
                    .Caption = "&Botão1"
                    .OnAction = "Copasmenor"
                End With
                     
                With .CommandBar.Controls.Add(Type:=msoControlButton)
                    .FaceId = 487
                    .Caption = "Botão 2"
                    .OnAction = "Botão2"
                End With
           
            End With
           
                     
            With .Controls.Add(Type:=msoControlPopup)
            .Caption = "&SubItem 2"
           
                With .CommandBar.Controls.Add(Type:=msoControlButton)
                    .FaceId = 59
                    .Caption = "Botão3"
                    .OnAction = "Copasmaior"
                End With
                With .CommandBar.Controls.Add(Type:=msoControlButton)
                    .FaceId = 74
                    .Caption = "Botão4"
                    .OnAction = "Ouromaior"
                End With
           
            End With
           
        End With

    ' Item romover do menu
    With MeuMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Remover este menu"
        .OnAction = ThisWorkbook.Name & "!RemoveMenu"
        .Style = msoButtonIconAndCaption
        .FaceId = 67
        .BeginGroup = True
    End With
    Set MeuSubMenu = Nothing
    Set MeuMenu = Nothing
End Sub
Sub RemoveMenu()
On Error Resume Next
    CommandBars.FindControl(Tag:="MeusMenus").Delete
End Sub
Sub primeiramacro()
MsgBox ("Você clicou no primeiro submenu")
End Sub
Sub segundamacro()
MsgBox ("Você clicou no segundo submenu")
End Sub
Sub terceiramacro()
MsgBox ("Você clicou no terceiro submenu")
End Sub
Sub botao1()
MsgBox ("Você clicou no botão 1")
End Sub


OBS:

Lembre-se de excluir os menus antes de fechar a planilha ou inserir uma rotina autoclose para isso. Caso você esquecer, estas barras ficarão visíveis em outras planilhas porem não funcionarão. Você ainda pode excluir clicando com o botão direito sobre o menu e escolher a opção excluir.
Segue a macro para remover automaticamente ao fechar a planilha.

Sub auto_close()
On Error Resume Next
    CommandBars("Barra_Planilhas").Delete
    CommandBars.FindControl(Tag:="MeusMenus").Delete
    Application.CommandBars(MinhaBarra).Delete
End Sub


BAIXE A PLANILHA EXEMPLO

VEJA A VÍDO AULA