Macros Excel – Cómo crear un menú

jueves, febrero 15, 2007

En las últimas dos notas vimos cómo automatizar una tarea con macros en Excel, como hacer la macro disponible para todos los cuadernos en la sesión y como convertirla en un complemento (Add-in). Esto último nos permite usar y distribuir la macro eficientemente.
Para activar la macro del complemento mostramos como crear una barra de herramientas cada vez que instalamos el complemento.
Otro método, que personalmente prefiero, es agregar un menú en la barra de menús.
Normalmente la barra de menús se ve así




En esta nota veremos una técnica relativamente sencilla para agregar un nuevo elemento en la barra de menús, desde donde podremos activar nuestras macros



Como se puede ver, hemos agregado un nuevo menú, "Mis Macros", entre los menús "Ventana" y "Ayuda". Si pulsamos el menú veremos dos entradas



Cada entrada activa una macro.

La técnica que hemos usado es la propuesta por John Walkenbach. La técnica consiste en almacenar todos los datos del menú en una hoja Excel; luego en un módulo de Vba escribir una rutina para crear el menú de acuerdo a los datos de la hoja y otra rutina para borrar el menú cuando cerramos la aplicación.
Una vez creadas la hoja y la rutina, agregamos eventos para correr las macros de creación y borrado del menú. Finalmente convertimos el archivo en complemento, que luego podremos instalar-

Veamos el ejemplo. Hemos creado una macro, N_Gris, para poner negrita y fondo gris a un rango. Una segunda macro, Saludar, nos saludará con la fórmula adecuada de acuerdo a la hora del día.

Una vez creadas las macros, creamos la hoja "Menu" que guardará los datos del menú.



La hoja Menu usa cinco columnas

Level (Nivel): determina la ubicación de la entrada en el menú en forma jerárquica.
Caption (Título/Subtítulo): es el texto que aparece en la entrada del menú.
Position/Macro (Posición/Macro); en el nivel 1 debe ser un número entero que determina la posición en la barra de menús.
Divider (Divisor): Si queremos que aparezca una línea divisora entre dos entradas del menú ponemos TRUE.
FaceID: es el número que representa la imagen/icono que queremos que aparezca al lado del texto.

La macro que crea el menú, es la siguiente

Sub CreateMenu()

   Dim Menu As Worksheet
   Dim MenuObject As CommandBarPopup

   Dim MenuItem As Object
   Dim SubMenuItem As CommandBarButton
   Dim Row As Integer
   Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId

''''''''''''''''''''''''''''''''''''''''''''''''''''
' Location for menu data
Set Menu = ThisWorkbook.Sheets("Menu")
''''''''''''''''''''''''''''''''''''''''''''''''''''

  ' Make sure the menus aren't duplicated
   Call DeleteMenu

  ' Initialize the row counter
     Row = 2

  ' Add the menus, menu items and submenu items using
  ' data stored on Menu

     Do Until IsEmpty(Menu.Cells(Row, 1))
     With Menu
     MenuLevel = .Cells(Row, 1)
     Caption = .Cells(Row, 2)
     PositionOrMacro = .Cells(Row, 3)
     Divider = .Cells(Row, 4)
     FaceId = .Cells(Row, 5)
     NextLevel = .Cells(Row + 1, 1)
    End With

     Select Case MenuLevel
       Case 1 ' A Menu
' Add the top-level menu to the Worksheet CommandBar
   Set MenuObject = Application.CommandBars(1). _
   Controls.Add(Type:=msoControlPopup, _
   Before:=PositionOrMacro, _
   Temporary:=True)
   MenuObject.Caption = Caption

     Case 2 ' A Menu Item
     If NextLevel = 3 Then
   Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
   Else
   Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
   MenuItem.OnAction = PositionOrMacro
   End If
   MenuItem.Caption = Caption
'If FaceId <> "" Then MenuItem.FaceId = FaceId
   If Divider Then MenuItem.BeginGroup = True

   Case 3 ' A SubMenu Item
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId <> "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select
Row = Row + 1
Loop
End Sub

Para borrar el menú usamos esta macro

Sub DeleteMenu()
' This sub should be executed when the workbook is closed
' Deletes the Menus
Dim Menu As Worksheet
Dim Row As Integer
Dim Caption As String

On Error Resume Next
Set Menu = ThisWorkbook.Sheets("Menu")
Row = 2
Do Until IsEmpty(Menu.Cells(Row, 1))
If Menu.Cells(Row, 1) = 1 Then
Caption = Menu.Cells(Row, 2)
Application.CommandBars(1).Controls(Caption).Delete
End If
Row = Row + 1
Loop
On Error GoTo 0
End Sub

En el objeto ThisWorkbook ponemos estos dos eventos

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call DeleteMenu
End Sub

Private Sub Workbook_Open()
    Call CreateMenu

    MsgBox "Se ha agregado el menú Mis Macros delante del menu de Ayuda", vbInformation

End Sub

Finalmente, guardamos el cuaderno como complemento, pasamos al editor de Vba, cambiamos la propiedad IsAddin del objeto ThisWorkbook a TRUE y guardamos el proyecto con el menú Archivo del editor. Todo este proceso está explicado en la nota anterior.

Para instalar el complemento, usamos el menú Herramientas—Complementos. Si el complemento no aparece en la lista, usamos el botón Examinar para instalarlo. Una vez instalado veremos este mensaje



y el menú "Mis Macros" aparecerá en el lugar planeado




Technorati Tags:

5 comments:

Fer Cipriani 26 febrero, 2008 03:30  

Jorge, abuso de tus conocimientos de Excel a ver si estoy haciendo lo correcto.

Tengo un libro con muuuchas macros y el crear un menú para manejarlas me parece la forma mas acertada y limpia de trabajar.

Hay macros que pretendo funciones sólo con determinadas hojas. Mas allá de verificar cuando se active la macro hacer una verificación de la hoja, se me ocurre hacer una variación de lo que proponés pero en vez de un gran menú referido al libro, prefiero tenér pequeños menúes referidos a cada hoja:

Por ejemplo:

Private Sub Worksheet_Activate()
CreateMenu01
End Sub

Private Sub Worksheet_Deactivate()
RemoveMenu01
End Sub


Hice un ejemplo de prueba y parece funcionar. Recurro a tu experiencia por si se me escapa algo.

Agradecido de antemano,
Fernando Cipriani

Jorge L. Dunkelman 26 febrero, 2008 19:13  

Hola,
lo más importante en toda macro, es que funcione. La idea de activar y desactivar menúes de acuerdo a la hoja me parece muy buena.

Anónimo,  29 agosto, 2010 18:35  

Hola Jorge
Felicitaciones por tu Blog, es un aporte interesante para los que estamos interesados en aprender cada día más sobre las bondades de excel. Te comento que hace poco mas de un mes estoy ingresando a tu Blog por recomendación de un amigo y he logrado conseguir información para mis trabajos.
En esta ocasión estoy realizando un libro de presupuesto y resulta que una de las instrucciones debe buscar las diferentes actividades que son alrededor de 500, pero no todas se utilizan al mismo tiempo, lo que hace que al momento de calcular se demora porque debe revisar todas las celdas incluyendo las que estan vacias. Mi consulta es precisamente cómo hacer una instrucción que al encontrar celdas vacía siga el otro procedimiento. Te dejo aquí el procedimiento que estoy utilizando
For a = 1 To 40
Range("AN1").Select
Selection.End(xlDown).Select
Application.CutCopyMode = False
Selection.Copy
Range("AM5").Select
ActiveSheet.Paste
If Range("AM2") = 1 Then
Range("AN1").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
Sheets("INFORME").Select
Range("B3050").Select
Selection.End(xlUp).Select
ActiveCell.Offset(3, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Font.Bold = True
Sheets("DATOS").Select
For b = 1 To 500
Range("Z1").Select
Selection.End(xlDown).Select
If ActiveCell.Value = Range("AM5") Then
Selection.ClearContents
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Sheets("INFORME").Select
Range("C3050").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("DATOS").Select
End If
Selection.ClearContents
Next b

Range("O7:O3006").Select
Selection.Copy
Range("Z7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AN3008").Select
Selection.End(xlToRight).Select
Selection.Copy
Sheets("INFORME").Select
Range("H3050").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -2).Select
ActiveCell.FormulaR1C1 = "SUBTOTAL"
Range(Selection, Selection.End(xlToRight)).Select
Selection.Font.Bold = True
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Sheets("DATOS").Select
End If
Range("AN1").Select
Selection.End(xlDown).Select
Selection.ClearContents
Range("AN3008").Select
Selection.End(xlToRight).Select
Selection.ClearContents
Next a
Te agradezco de antemano toda tu colaboración en esta inquietud.
Un abrazo.

Jorge L. Dunkelman 29 agosto, 2010 20:57  

Estimado anónimo,
por favor, tomate el trabajo de leer lo que escribo en Ayuda (el enlace en la parte superior del blog).
Enviame la consulta por mail privado, tal como indico en el enlace.

Enrique Robles urbina 14 setiembre, 2010 18:34  

Hola, quiesiera saber si me puedes ayudar, estoy tratando de hacer un menu en excel 2007 y quisiera saber como agregar imegenes a los menús. Gracias

Publicar un comentario

Google+ Followers

Seguidores

Google+ Badge

Términos Legales

  © Blogger template On The Road by Ourblogtemplates.com 2009

Back to TOP