miércoles, 30 de septiembre de 2015

Como crear un menú personalizado en Excel con VBA

Como han podido observar, he venido publicando algunos post, sobre Macros (VBA) en este blog. Y ahora les voy a explicar como crear un menú personalizado dentro del Excel 2007, 2010 o superior.
Para lograrlo debemos entrar al Visual Basic (ALT + F11) e insertamos un módulo, como veremos a continuación...

En la ventana en blanco que nos aparece copiaremos el siguiente código, el cual iré explicando paso a paso, como dirían los New Kids on the Block (si entendiste el chiste, tienes entre 35 y 45 años)...

Option Private Module

'---------------------------------------------------------------------
Sub Auto_Open()
     'Este proceso se ejecuta en el momento de abrir el archivo de Excel
     'Es decir, cuando abres el archivo actual generará el menú inmediatamente
    GeneraMenu
End Sub

'---------------------------------------------------------------------
Sub Auto_Close()
     'Este proceso se ejecuta en el momento de cerrar el archivo de Excel
     'Es decir, cuando cierras el archivo actual elimina el menú inmediatamente
     BorraMenu
End Sub

'---------------------------------------------------------------------
Public Sub GeneraMenu()
    
    Dim strCBarName As String
    Dim strMenuName As String
    Dim bef         As Single
    Dim cbrMenu     As CommandBarControl
    Dim cbrMenu1     As CommandBarControl
        
'    Generación del Menú de la aplicación
    strCBarName = "Worksheet Menu Bar"
    strMenuName = "Menu personalizado"
    bef = 8
    
    
    On Error Resume Next
    Application.CommandBars(strCBarName).Controls(strMenuName).Delete
    On Error GoTo 0
    
    Set cbrMenu = CBAddMenu(strCBarName, strMenuName, bef)
    
    Call CBAddMenuBoton(cbrMenu, "Inicio", "Macro_Inicio")
    ' Genera el menú inicio dentro del Excel, el cual al hacer clic en él, llamara a Macro_Inicio
    Call CBAddMenuBoton(cbrMenu, "Usuarios", "Macro_Usuarios")
    Call CBAddMenuBoton(cbrMenu, "Listas", "Macro_Listas")
    
    'Ahora creo un submenú
    Call CBAddMenuPopup(cbrMenu, "Mantenimiento")
       Set cbrMenu1 = Application.CommandBars(strCBarName).Controls(strMenuName).Controls("Mantenimiento")
        Call CBAddMenuBoton(cbrMenu1, "Tabla1", "Macro_Tabla1")
        Call CBAddMenuBoton(cbrMenu1, "Tabla2", "Macro_Tabla2")
        Call CBAddMenuBoton(cbrMenu1, "Tabla3", "Macros_Tabla3")
End Sub

'---------------------------------------------------------------------
'Función que agrega un Menú
Function CBAddMenu(strCBarName As String, _
                   strMenuName As String, bef As Single) As CommandBarControl
                   
    Dim cbrBar As CommandBar
    Dim ctlCBarControl As CommandBarControl
    
    On Error Resume Next
    Set cbrBar = CommandBars(strCBarName)
    If Err <> 0 Then
        Set cbrBar = CommandBars.Add(strCBarName)
        Err = 0
    End If
    
    With cbrBar
        Set ctlCBarControl = .Controls.Add(msoControlPopup, , , bef)
        ctlCBarControl.Caption = strMenuName
    End With
    Set CBAddMenu = ctlCBarControl
End Function

'---------------------------------------------------------------------
'Función que agrega un botón
Function CBAddMenuBoton(cbrMenu As CommandBarControl, _
                          strCaption As String, _
                          strOnAction As String) As Boolean
    
    Dim ctlCBarControl As CommandBarControl
    
    With cbrMenu
        Set ctlCBarControl = .Controls.Add(msoControlButton)
        With ctlCBarControl
            .Caption = strCaption
            .OnAction = strOnAction
            .Tag = .Caption
            Select Case strCaption
                Case "Ingreso de Visitas"
                    .BeginGroup = True
                Case "Terminar"
                    .BeginGroup = True
            End Select
        End With
    End With
End Function

'---------------------------------------------------------------------
'Función que agrega un popup
Function CBAddMenuPopup(cbrMenu As CommandBarControl, strCaption As String) As Boolean
    
    Dim ctlCBarControl As CommandBarControl
    
    With cbrMenu
        Set ctlCBarControl = .Controls.Add(msoControlPopup)
        With ctlCBarControl
            .Caption = strCaption
            Select Case strCaption
                Case "Mantenimiento"
                    .BeginGroup = True
            End Select
        End With
    End With
End Function

'---------------------------------------------------------------------
'Rutina de salida de la aplicación
Public Sub BorraMenu()
                           
    Dim strCBarName As String
    Dim strMenuName As String
    
    strCBarName = "Worksheet Menu Bar"
    strMenuName = "Menu personalizado"
    
    On Error Resume Next
    Application.CommandBars(strCBarName).Controls(strMenuName).Delete

End Sub


Una vez que escribiste todo el código, cierras Visual Basic for Application, y guardas el archivo como ... Archivo de Excel habilitado para Macros.

Al cerrarlo y volverlo a abrir, aparecerá el menú...


Cada vez que cerremos el archivo, el menú desaparece, y vuelva a generarse cuando abrimos el archivo.

Espero que les sirva, cualquier consulta al 800-ENRIQUE mentira, me escriben por este medio.

Ing. Enrique Neciosup Morales
enrique@expertosenexcelpc.com 
Síguenos en Facebook

No hay comentarios.:

Publicar un comentario