Excel - Menus en Excel

 
Vista:

Menus en Excel

Publicado por Jose Gpe (75 intervenciones) el 21/11/2007 17:45:33
Alguien Tiene un Archivo en Excel en base a un codigo, al correrlo me ponga en el Menu de excel los siguiente:

ejmplo
Archivos Edicion Ver Insertar Formato Etc. My Menu
Ejcicio 2007
NOMINAS
Almacen
Administracion

y al dar click en nominas me abra el archivo siguiente: C:\EJERCICIO 2007\NOMINAS\Alamcen.XLS
asi sucesivamente los demas archivos.

Gracias
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

RE:Menus en Excel

Publicado por JuanC (792 intervenciones) el 22/11/2007 00:21:45
ahora sí se entiende lo que querés...
te paso un código comentado y modificado (no es mío, lo tengo de 'plantilla')
supongo que sabés algo de VBA, si no es así no te va a servir de mucho...

Option Explicit
Option Private Module

'//---------------------------------
'// Estructura general de un Menú
'//
'// Menú
'// + Primer elemento
'// + 1er ítem
'// + 2do ítem
'// + Segundo elemento
'// + 1er elemento
'// + 2do elemento
'//---------------------------------

Private Const cCAPTION = "&AAA" '//Caption del menú
Private Const cNAME = "AAAA" '//Nombre Addins
Private Const cHELP = "AAA.hlp" '//Archivo de Ayuda
Private Const cMENU_NAME = "Sheet_Menu_Bar" '//Nombre del menú

Private sPath As String '//Ruta del Addins

Public Sub Auto_Open()
sPath = GetPath(cNAME)
Call AddMenu(cMENU_NAME)
End Sub

Public Sub Auto_Close()
Call RemoveMenu(cMENU_NAME)
End Sub

Private Sub AddMenu(ByVal sMenu As String)
Dim Menu As Object, MnItem As Object
Dim SubMnItem As Object
Dim iPos%, j%

'//Primero lo elimina
Call RemoveMenu(sMenu)

'//Busca posición del menú
iPos = 0: j = 1
For Each MnItem In Application.CommandBars(sMenu).Controls
If MnItem.Caption = "&Window" Then
iPos = j
End If
j = j + 1
Next MnItem

'//Corrige posición para ir antes del menú Ventana (Window)
If iPos = 0 Then iPos = j - 2

'//Nombre del menú
Set Menu = Application.CommandBars(sMenu).Controls.Add( _
Type:=msoControlPopup, Before:=iPos, Temporary:=True)
Menu.Caption = cCAPTION

'//Primer elemento del menú
Set MnItem = AddMnItem(Menu, "&B", ItemType:=msoControlPopup)
'//Items del 1er elemento del menú
Set SubMnItem = AddMnItem(MnItem, "&BB", "DoBB")
Set SubMnItem = AddMnItem(MnItem, "&BBB", "DoBBB")

'//Segundo elemento del menú
Set MnItem = AddMnItem(Menu, "&C", ItemType:=msoControlPopup)
'//Items del 2do elemento del menú
Set SubMnItem = AddMnItem(MnItem, "&CC", "DoCC")
Set SubMnItem = AddMnItem(MnItem, "&CCC", "DoCCC", BeginGroup:=True)

'Set BuildMenu = Menu
Set Menu = Nothing
Set MnItem = Nothing
End Sub

Private Sub RemoveMenu(ByVal sMenu As String)
On Error Resume Next
Application.CommandBars(sMenu).Controls(cCAPTION).Delete
End Sub

Private Function AddMnItem(Menu As Object, _
ItemName As String, _
Optional Action = "", _
Optional ItemType = msoControlButton, _
Optional BeginGroup = False) As Object
Dim MnItem As Object

Set MnItem = Menu.Controls.Add(Type:=ItemType)
With MnItem
.Caption = ItemName
If Action <> "" Then .OnAction = Action
.BeginGroup = BeginGroup
End With

Set AddMnItem = MnItem
Set MnItem = Nothing
End Function

Private Function GetPath(sName As String) As String
On Error GoTo ErrHandler
GetPath = Application.AddIns(sName).Path & "\"
Exit Function

ErrHandler:
GetPath = ""
End Function

Saludos desde Baires, JuanC
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar