Consulta de código implementado en excel con un error
¿Pueden probarlo y decirme que estoy haciendo mal?
Sub MiPrimerBarraDeMenu()
Dim MiBarra As CommandBar
Dim MiMenu As Object
Dim MiElementoDeMenu As Object
Set MiBarra = CommandBars.Add(Name:="Hora17", _
Position:=msoBarTop, MenuBar:=True, _
Temporary:=True)
MiBarra.Controls.Add Type:=msoControlPopup, ID:=30002, Before:=1
Set MiMenu = MiBarra.Controls.Add(Type:=msoControlPopup, _
Temporary:=True)
MiMenu.Caption = "Hora 17"
Set MiElementoDeMenu = MiMenu.Controls.Add(Type:=msoControlButton, ID:=1)
MiElementoDeMenu.Caption = "Demo de macro"
MiElementoDeMenu.Style = msoButtonCaption
MiElementoDeMenu.OnAction = "Muestrame"
CommandBars("WorkSheet Menu Bar").Visible = False
MiBarra.Visible = True
End Sub
Sub MiPrimerBarraDeMenu()
Dim MiBarra As CommandBar
Dim MiMenu As Object
Dim MiElementoDeMenu As Object
Set MiBarra = CommandBars.Add(Name:="Hora17", _
Position:=msoBarTop, MenuBar:=True, _
Temporary:=True)
MiBarra.Controls.Add Type:=msoControlPopup, ID:=30002, Before:=1
Set MiMenu = MiBarra.Controls.Add(Type:=msoControlPopup, _
Temporary:=True)
MiMenu.Caption = "Hora 17"
Set MiElementoDeMenu = MiMenu.Controls.Add(Type:=msoControlButton, ID:=1)
MiElementoDeMenu.Caption = "Demo de macro"
MiElementoDeMenu.Style = msoButtonCaption
MiElementoDeMenu.OnAction = "Muestrame"
CommandBars("WorkSheet Menu Bar").Visible = False
MiBarra.Visible = True
End Sub
1 respuesta
Respuesta de jgirj
1
Si lo que euieres es agregar un item a tu barra de herramientas puedes guiarte por este ejemplo:
Sub Auto_Open()
On Error Resume Next
For Each mb In MenuBars
With mb.Menus("Tools")
Call .MenuItems.Add("Mi Suma", "Mi_Suma")
End With
Next mb
End Sub
Sub Auto_Close()
Dim mi As Object
Dim mb As Object
On Error Resume Next
For Each mb In MenuBars
For Each mi In mb.Menus("Tools").MenuItems
If mi.Caption = "Mi Suma" Then
mi.Delete
End If
Next
Next
AddIns("Mi Suma").Installed = False
End Sub
Si no te sirve escribe de nuevo
Sub Auto_Open()
On Error Resume Next
For Each mb In MenuBars
With mb.Menus("Tools")
Call .MenuItems.Add("Mi Suma", "Mi_Suma")
End With
Next mb
End Sub
Sub Auto_Close()
Dim mi As Object
Dim mb As Object
On Error Resume Next
For Each mb In MenuBars
For Each mi In mb.Menus("Tools").MenuItems
If mi.Caption = "Mi Suma" Then
mi.Delete
End If
Next
Next
AddIns("Mi Suma").Installed = False
End Sub
Si no te sirve escribe de nuevo
