Menus en Excel
Publicado por Jose Gpe. Sanchez (75 intervenciones) el 22/04/2008 21:08:42
Saludos
Encontre este codigo para generar un Menu en Ecel, alguien que lo analize y me pueda decir como hacerle para agregar mas niveles, mandame tu correo para estar mas en contacto e intercambiar ejemplos
Gracias por tu ayuda
Sub CreateMenu()
' creates a new menu.
' can also be used to create commandbarbuttons
Dim cb As CommandBar, cbMenu As CommandBarControl, cbSubMenu As CommandBarControl
DeleteCommandBar ' delete the custom menu if it already exists
' create a new menu bar to replace the built-in menu bar
Set cb = Application.CommandBars.Add("MyCommandBarName", msoBarTop, True, True)
' create a new menu on an existing commandbar (the next 6 lines)
Set cbMenu = cb.Controls.Add(msoControlPopup, , , , True)
With cbMenu
.Caption = "&Mi menú"
.Tag = "MyTag"
.BeginGroup = False
End With
' or add to an existing menu (use the next line instead of the previous 6 lines)
'Set cbMenu = Application.CommandBars.FindControl(, 30007) ' Tools-menu
If cbMenu Is Nothing Then Exit Sub ' didn't find the menu...
' add menuitem to menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&MenuItem1"
.OnAction = ThisWorkbook.Name & "!Macroname"
End With
' add menuitem to menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&MenuItem2"
.OnAction = ThisWorkbook.Name & "!Macroname"
End With
' add a submenu
Set cbSubMenu = cbMenu.Controls.Add(msoControlPopup, 1, , , True)
With cbSubMenu
.Caption = "&Submenu1"
.Tag = "SubMenu1"
.BeginGroup = True
End With
' add menuitem to submenu (or buttons to a commandbar)
With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Submenu Item1"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 71
.State = msoButtonDown
End With
' add menuitem to submenu (or buttons to a commandbar)
With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Submenu Item2"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 72
.Enabled = False
End With
' add a submenu to the submenu
Set cbSubMenu = cbSubMenu.Controls.Add(msoControlPopup, 1, , , True)
With cbSubMenu
.Caption = "&Submenu2"
.Tag = "SubMenu2"
.BeginGroup = True
End With
' add menuitem to submenu submenu
With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Submenu Item1"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 71
.State = msoButtonDown
End With
' add menuitem to submenu submenu
With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Submenu Item2"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 72
.Enabled = False
End With
' add menuitem to menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Eliminar este menú"
.OnAction = ThisWorkbook.Name & "!DeleteCommandBar"
.Style = msoButtonIconAndCaption
.FaceId = 463
.BeginGroup = True
End With
' display the new menu
cb.Visible = True
Set cbSubMenu = Nothing
Set cbMenu = Nothing
Set cb = Nothing
End Sub
Encontre este codigo para generar un Menu en Ecel, alguien que lo analize y me pueda decir como hacerle para agregar mas niveles, mandame tu correo para estar mas en contacto e intercambiar ejemplos
Gracias por tu ayuda
Sub CreateMenu()
' creates a new menu.
' can also be used to create commandbarbuttons
Dim cb As CommandBar, cbMenu As CommandBarControl, cbSubMenu As CommandBarControl
DeleteCommandBar ' delete the custom menu if it already exists
' create a new menu bar to replace the built-in menu bar
Set cb = Application.CommandBars.Add("MyCommandBarName", msoBarTop, True, True)
' create a new menu on an existing commandbar (the next 6 lines)
Set cbMenu = cb.Controls.Add(msoControlPopup, , , , True)
With cbMenu
.Caption = "&Mi menú"
.Tag = "MyTag"
.BeginGroup = False
End With
' or add to an existing menu (use the next line instead of the previous 6 lines)
'Set cbMenu = Application.CommandBars.FindControl(, 30007) ' Tools-menu
If cbMenu Is Nothing Then Exit Sub ' didn't find the menu...
' add menuitem to menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&MenuItem1"
.OnAction = ThisWorkbook.Name & "!Macroname"
End With
' add menuitem to menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&MenuItem2"
.OnAction = ThisWorkbook.Name & "!Macroname"
End With
' add a submenu
Set cbSubMenu = cbMenu.Controls.Add(msoControlPopup, 1, , , True)
With cbSubMenu
.Caption = "&Submenu1"
.Tag = "SubMenu1"
.BeginGroup = True
End With
' add menuitem to submenu (or buttons to a commandbar)
With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Submenu Item1"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 71
.State = msoButtonDown
End With
' add menuitem to submenu (or buttons to a commandbar)
With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Submenu Item2"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 72
.Enabled = False
End With
' add a submenu to the submenu
Set cbSubMenu = cbSubMenu.Controls.Add(msoControlPopup, 1, , , True)
With cbSubMenu
.Caption = "&Submenu2"
.Tag = "SubMenu2"
.BeginGroup = True
End With
' add menuitem to submenu submenu
With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Submenu Item1"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 71
.State = msoButtonDown
End With
' add menuitem to submenu submenu
With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Submenu Item2"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 72
.Enabled = False
End With
' add menuitem to menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Eliminar este menú"
.OnAction = ThisWorkbook.Name & "!DeleteCommandBar"
.Style = msoButtonIconAndCaption
.FaceId = 463
.BeginGroup = True
End With
' display the new menu
cb.Visible = True
Set cbSubMenu = Nothing
Set cbMenu = Nothing
Set cb = Nothing
End Sub
Valora esta pregunta


0