Problemas con barra personalizada
Estoy adaptando un código que crea una barra de herramientas personalizada, pero tengo problemas con los submenus, pues solo me crea el 1º.
La idea es que me cree 2 submenus a partir del boron denomminado "Empresas con PGP".
Aquí te envío el trozo del código donde tengo la dificultad
Sub CreandoMiMenu() 'Comienza el procedimiento para crear el menú personalizado
Dim miMenu As CommandBarControl, SubMenu As CommandBarControl
'La sentencia Dim le dice a Excel el tipo de varibles que se utilizarán,
'en este caso ambas variables son del tipo CommandBarControl
RemoverMenu 'Esta sentencia llama al procedimiento RemoverMenu
Set miMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
'Esta sentencia le dice a Excel que agregue un elemento de menú al menú existente de Excel.
With miMenu
.Caption = "&Seg Trab"
'Esta sentencia le dice a Excel que el nuevo menú se llama "Seg Trab"
.Tag = "MyTag"
.BeginGroup = False
End With
If miMenu Is Nothing Then Exit Sub
With miMenu.Controls.Add(msoControlButton, 1, , , True)
'Esta sentencia, agrega un elemento al menú "Mi Menú"
.Caption = "&Basicos"
'Esta sentencia le dice a Excel que el elemento se llama "Basicos"
.OnAction = ThisWorkbook.Name & "!Macroname"
End With
With miMenu.Controls.Add(msoControlButton, 1, , , True)
'Esta sentencia, agrega un elemento al menú "Mi Menú"
.Caption = "&Estadisticas"
'Esta sentencia le dice a Excel que el elemento se llama "Estadisticas"
.OnAction = ThisWorkbook.Name & "!Macroname"
End With
Set SubMenu = miMenu.Controls.Add(msoControlPopup, 1, , , True)
'Esta sentencia le dice a Excel que agregue un subelemento de menú a "Mi Menú"
With SubMenu
.Caption = "&INDICADORES" 'Antes Indicadores 473 y 44
'Esta sentencia le dice a Excel que el nuevo submenú se llama "INDICADORES"
.Tag = "SubMenu1" '///////VER EL 2////////
.BeginGroup = True
End With
With SubMenu.Controls.Add(msoControlButton, 1, , , True)
'Esta sentencia, agrega un subelemento de menú al submenú "Submenu1"
.Caption = "&Emp prevenIMSS"
'Esta sentencia le dice a Excel que el subelemento se llama "Emp prevenIMSS"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 71
.State = msoButtonDown
End With
With SubMenu.Controls.Add(msoControlButton, 1, , , True)
'Esta sentencia, agrega un subelemento de menú al submenú "Submenu1"
.Caption = "&Empresas con PGP" 'Antes Submenu Item2
'Esta sentencia le dice a Excel que el subelemento se llama "Empresas con PGP"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 72
.Enabled = True
End With
'==========================================================================
Set SubMenu = SubMenu.Controls.Add(msoControlPopup, 1, , , True)
With SubMenu
.Caption = "&Emp Afiliadas" 'Antes Submenu2
.Tag = "SubMenu2"
.BeginGroup = True 'Encabeza el grupo
End With
'///////////////////////////////////////////////////////////////////////////
'***************************************************************************
'Aqui deberia insertarse la 2ª opcion del submenu "Empresas con PGP"
'Set SubMenu = SubMenu.Controls.Add(msoControlPopup, , , , True)
'With SubMenu
'.Caption = "&Centros IMSS"
'.Tag = "SubMenu2"
'.BeginGroup = False
'End With
'**************************************************************************
'//////////////////////////////////////////////////////////////////////////
With SubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Submenu Item1"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 71
.State = msoButtonDown
End With
With SubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Submenu Item2"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 72
.Enabled = True
End With
With miMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Remover este menu"
.OnAction = ThisWorkbook.Name & "!RemoverMenu"
.Style = msoButtonIconAndCaption
.FaceId = 463
.BeginGroup = True
End With
Set SubMenu = Nothing
Set miMenu = Nothing
End Sub 'Esta sentencia termina el procedimiento CrearMenu
Gracias anticipadas
La idea es que me cree 2 submenus a partir del boron denomminado "Empresas con PGP".
Aquí te envío el trozo del código donde tengo la dificultad
Sub CreandoMiMenu() 'Comienza el procedimiento para crear el menú personalizado
Dim miMenu As CommandBarControl, SubMenu As CommandBarControl
'La sentencia Dim le dice a Excel el tipo de varibles que se utilizarán,
'en este caso ambas variables son del tipo CommandBarControl
RemoverMenu 'Esta sentencia llama al procedimiento RemoverMenu
Set miMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
'Esta sentencia le dice a Excel que agregue un elemento de menú al menú existente de Excel.
With miMenu
.Caption = "&Seg Trab"
'Esta sentencia le dice a Excel que el nuevo menú se llama "Seg Trab"
.Tag = "MyTag"
.BeginGroup = False
End With
If miMenu Is Nothing Then Exit Sub
With miMenu.Controls.Add(msoControlButton, 1, , , True)
'Esta sentencia, agrega un elemento al menú "Mi Menú"
.Caption = "&Basicos"
'Esta sentencia le dice a Excel que el elemento se llama "Basicos"
.OnAction = ThisWorkbook.Name & "!Macroname"
End With
With miMenu.Controls.Add(msoControlButton, 1, , , True)
'Esta sentencia, agrega un elemento al menú "Mi Menú"
.Caption = "&Estadisticas"
'Esta sentencia le dice a Excel que el elemento se llama "Estadisticas"
.OnAction = ThisWorkbook.Name & "!Macroname"
End With
Set SubMenu = miMenu.Controls.Add(msoControlPopup, 1, , , True)
'Esta sentencia le dice a Excel que agregue un subelemento de menú a "Mi Menú"
With SubMenu
.Caption = "&INDICADORES" 'Antes Indicadores 473 y 44
'Esta sentencia le dice a Excel que el nuevo submenú se llama "INDICADORES"
.Tag = "SubMenu1" '///////VER EL 2////////
.BeginGroup = True
End With
With SubMenu.Controls.Add(msoControlButton, 1, , , True)
'Esta sentencia, agrega un subelemento de menú al submenú "Submenu1"
.Caption = "&Emp prevenIMSS"
'Esta sentencia le dice a Excel que el subelemento se llama "Emp prevenIMSS"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 71
.State = msoButtonDown
End With
With SubMenu.Controls.Add(msoControlButton, 1, , , True)
'Esta sentencia, agrega un subelemento de menú al submenú "Submenu1"
.Caption = "&Empresas con PGP" 'Antes Submenu Item2
'Esta sentencia le dice a Excel que el subelemento se llama "Empresas con PGP"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 72
.Enabled = True
End With
'==========================================================================
Set SubMenu = SubMenu.Controls.Add(msoControlPopup, 1, , , True)
With SubMenu
.Caption = "&Emp Afiliadas" 'Antes Submenu2
.Tag = "SubMenu2"
.BeginGroup = True 'Encabeza el grupo
End With
'///////////////////////////////////////////////////////////////////////////
'***************************************************************************
'Aqui deberia insertarse la 2ª opcion del submenu "Empresas con PGP"
'Set SubMenu = SubMenu.Controls.Add(msoControlPopup, , , , True)
'With SubMenu
'.Caption = "&Centros IMSS"
'.Tag = "SubMenu2"
'.BeginGroup = False
'End With
'**************************************************************************
'//////////////////////////////////////////////////////////////////////////
With SubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Submenu Item1"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 71
.State = msoButtonDown
End With
With SubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Submenu Item2"
.OnAction = ThisWorkbook.Name & "!Macroname"
.Style = msoButtonIconAndCaption
.FaceId = 72
.Enabled = True
End With
With miMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Remover este menu"
.OnAction = ThisWorkbook.Name & "!RemoverMenu"
.Style = msoButtonIconAndCaption
.FaceId = 463
.BeginGroup = True
End With
Set SubMenu = Nothing
Set miMenu = Nothing
End Sub 'Esta sentencia termina el procedimiento CrearMenu
Gracias anticipadas
1 Respuesta
Respuesta de tcorredor
1