Menú de botones

[Antoni]

Hola:

¡¡ Lo he conseguido !! Me he superado a mi mismo, os adjunto el aporte mas inútil de la historia del foro.

Se trata de una macro:

Esta macro, crea un formulario con un botón con el nombre cada hoja

.Al ejecutar el formulario, se activa la hoja con el nombre del botón

.Al formulario, se le han añadido las Apis para poder minimizarlo

Y ahora os preguntareis. ¿Pero eso no es exactamente lo mismo que el tab de hojas?.

Pues efectivamente, es lo mismo que el tab de hojas, pero mas grande, mas feo y mas complicado.

Ya se había inventado la rueda, pero yo, la he reinventado, la he hecho cuadrada, para que no haga falta ponerle freno de mano a los coches.

Para probar esta maravilla del progreso humano, solo teneis que abrir cualquier libro, si puede ser con varias hojas, y hacer correr la macro "CrearFormularioMenú", luego ejecutar el formulario generado, y a pulsar botones.

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Const WS_MINIMIZEBOX As Long = &H20000

Private Const WS_MAXIMIZEBOX As Long = &H10000

Private Const GWL_STYLE As Long = (-16)

'-------------------------------------------------

Private Sub UserForm_Initialize()

Dim lngMyHandle As Long, lngCurrentStyle As Long, lngNewStyle As Long

'-------------------------------------------------

lngMyHandle = FindWindow("THUNDERDFRAME", "Menú general")

lngCurrentStyle = GetWindowLong(lngMyHandle, GWL_STYLE)

lngNewStyle = lngCurrentStyle Or WS_MINIMIZEBOX 'Or WS_MAXIMIZEBOX

SetWindowLong lngMyHandle, GWL_STYLE, lngNewStyle

End Sub

'

'¡¡¡ NO AÑADIR/QUITAR/MODIFICAR NADA ANTES DE ESTA LINEA !!!

'

'--------------------------------------------------------------------

' Esta macro, crea un formulario con un botón con el nombre cada hoja

' .Al ejecutar el formulario, se activa la hoja con el nombre del botón

' .Al formulario, se le han añadido las Apis para poder minimizarlo

'--------------------------------------------------------------------

'

Sub CrearFormularioMenú()

Dim Formulario As Object

Dim Boton As MSForms.CommandButton

'----------------------------- AÑADIMOS EL FORMULARIO -----------------

Set Formulario = ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)

With Formulario

    .Properties("ShowModal") = False

    .Properties("Caption") = "Menú general"

    .Properties("Width") = 158

    .Properties("Height") = Sheets.Count * 50 + 28

End With

'------------------------------ AÑADIMOS LAS APIS ----------------

Set Desde = ActiveWorkbook.VBProject.VBComponents("Módulo1").CodeModule

With ActiveWorkbook.VBProject.VBComponents(Formulario.Name).CodeModule

    .InsertLines .CountOfLines + 1, Desde.Lines(1, 19)

End With

'--------------------------------------------------------------------------

X = ActiveWorkbook.VBProject.VBComponents(Formulario.Name).CodeModule.CountOfLines + 1

For m = 1 To Sheets.Count

    Set Boton = Formulario.Designer.Controls.Add("forms.CommandButton.1")

    With Formulario

      '-------------- AÑADIMOS UN COMMANDBUTTON POR CADA HOJA ---------------

      .Designer.Controls(Formulario.Designer.Controls.Count - 1).Name = "Boton" & m

      .Designer.Controls(Formulario.Designer.Controls.Count - 1).Caption = Sheets(m).Name

      .Designer.Controls(Formulario.Designer.Controls.Count - 1).Width = 150

      .Designer.Controls(Formulario.Designer.Controls.Count - 1).Height = 50

      .Designer.Controls(Formulario.Designer.Controls.Count - 1).Top = 2 + 50 * (m - 1)

      .Designer.Controls(Formulario.Designer.Controls.Count - 1).Left = 2

      '--------------- AÑADIMOS EL EVENTO CLICK PARA CADA COMMANDBUTTON ---- 

      .CodeModule.InsertLines X, "Private Sub Boton" & m & "_Click()":          X = X + 1

      .CodeModule.InsertLines X, "Sheets(""" & Sheets(m).Name & """).Activate": X = X + 1

      .CodeModule.InsertLines X, "End Sub ":                                    X = X + 1

      '----------------------------------------------------------------------------------

   End With

Next m

End Sub

[/CODE]

Que el Señor os de paciencia para aguantarme en mi demencia.

Os tengo presentes en mis oraciones. Antoni.

[b][i][size=5][color=red]¡ Importante ! Ver posts Nº 10 y Nº 12[/color][/size][/i][/b]

[Invitado luigi]

Hola Antoni:

Lo primero reconocer que eres un Crack, Máster, Dios con esto del VBA después de haber visto, aunque no entendido por mi falta de conocimientos todavía, todo lo que desarrollas y aportas por el Foro.

Bueno ahora a lo que íbamos acabo de probar esto y me lanza este error ¿He hecho algo mal? Quedo a la espera de tus comentarios.

[ATTACH]16201.vB[/ATTACH]

Un Saludo de tú paisano, Luis.

[Antoni]

Hola Luis:

No, no has hecho nada mal, añade la referencia Microsoft Forms 2.0 Object Library (FM20.DLL) , y por si acaso asegurate de tener también la referencia Microsoft Visual Basic for Applications Extensibility 5.3 (No se que DLL es).

Saludos. Antoni.

[Invitado luigi]

Hola de Nuevo Antoni:

He hecho lo que me has indicado

añade la referencia Microsoft Forms 2.0 Object Library (FM20.DLL) , y por si acaso asegurate de tener también la referencia Microsoft Visual Basic for Applications Extensibility 5.0 (No se que DLL es).

la referencia del Extensibility mia es la 5.3 y no me va, le he dado mil vueltas y nada, a ver si puedes guiarme el error que me da ahora es este

[ATTACH]16204.vB[/ATTACH]

Gracias por soportarme un saludo, Luis

[Antoni]

Hola Luis:

Tranquilo, si soporto a mi suegra y a mi cuñada, puedo soportar cualquier cosa....jajaja.

Mi versión de Extensibily tambien es la 5.3. (Voy a modificar el post)

¿ Que texto de error te da ?

[Invitado luigi]

Hola Antoni:

En la imagen esta de color amarillo la linea done dispara el error

La edad, me imagino.

Perdon por la Broma

[Antoni]

Y el texto del error debe estar de color blanco porqué no lo veo, jajaj.

Estoy intentando subir una imagen con las referencias.

Pincha aquí para ver las referencias

[Invitado luigi]

Eso lo tengo tal y como lo tienes tú, y otra imagen a ver si ahora lo ves

[ATTACH]16208.vB[/ATTACH]

Tienes un MP con el Link

[Antoni]

Hola:

Pienso que es un problema de seguridad.

Abre Excel, Boton office\Opciones excel\Centro de confianza\Configuración de macros

y activa "Confiar en el acceso al modelo de objetos de proyectos de VBA".

Ata logo.

[Abraham Valencia]

Hola Antoni: Creo saber que sucede. En el codigo que envias no estan, pero al crear el USerform, haces uso de 2 funciones del API de windows: FindWindow y SetWindowLong, por lo que sospecho que se te "escapo" al copiar/pegar. Ademas, al ver que copiar codigo hasta la linea 19, me hace estar mas seguro, aun, de eso.

Ah, no olvidar que de manera obliga el modulo en el que se copia tu codigo, debe ser uno "normal" llamado "Módulo1"

Saludos

Abraham

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _

ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _

ByVal hwnd As Long, _

ByVal nIndex As Long, _

ByVal dwNewLong As Long) As Long

[rolano]

Hola Master Antoni, ningun codigo es inutil es cuestion de saber utilizarlo, gracias por el aporte,

Tiene razon el Master Abraham faltaban 2 funicones Apis

¡¡ Lo he conseguido !! Me he superado a mi mismo, os adjunto el aporte mas inútil de la historia del foro.

Menu.xls - Windows Live

[Antoni]

Hola Abraham:

.....Ah, no olvidar que de manera obliga el modulo en el que se copia tu codigo, debe ser uno "normal" llamado "Módulo1"

De acuerdo con todas tus precisiones, y con esta en especial.

Se me olvidó comentar que la macro debe estar en un módulo normal.

He modificado la macro para que no copie las Apis, las he declarado como Public en la propia macro con lo que no se hace necesario incluirlas en el formulario.

Para que quede mas claro, adjunto un libro con el que ejecutar la macro y ver sus efectos.

Libro con la macro que genera formulario de botones

Gracias Abraham por tu interés. Saludos a todos.

[Abraham Valencia]

Pues de nada, y mas bien, gracias a ti por ese y otros aportes

Saludos

Abraham

[SidV]

Jo, este tema esta genial.

Agregado al grupo Only Code! - Ayuda Excel

Cracks, estan mas que invitados! xD

[ST_]

me gusto mas con botones a Height = 25

ademas agregaria 2 subrutinas mas al final (Bueno es una sugerencia,por lo menos a mi me gusta mas así)

Sub AbreFormulario()

    UserForm1.Show

End Sub

Private Sub Modificasubrutinas()

    Set localiza = ActiveWorkbook.VBProject.VBComponents("Módulo1").CodeModule

    n1 = localiza.ProcBodyLine("CrearFormularioMenú", vbext_pk_Proc)

    n2 = localiza.ProcBodyLine("AbreFormulario", vbext_pk_Proc)

    localiza.ReplaceLine n1, "Private Sub CrearFormularioMenú"

    localiza.ReplaceLine n2, "Sub AbreFormulario"

End Sub[/CODE]

y en la macro que crea el formulario, al final de la misma agregaria una linea para ejecutar "Modificasubrutinas",para que de esta manera:

[CODE]Sub CrearFormularioMenú
'............
Next m
[COLOR="red"][B]Modificasubrutinas[/B][/COLOR]
End Sub[/CODE]

1-solo se vea al principio la macro que crea el formulario al teclear Alt+F8 para ver las macros disponibles

2.-una vez creado el form,se pueda ocultar dicha macro y se encuentre/muestre visible la macro (AbreFormulario) que permita ver el formulario creado en tiempo de ejecucion.

por demas decirles que el form sule ser practico si nos deplazamos con las flechas de navegacion por los botones (claro ajsutados a una altura de 25 com ya lo comente al inicio)

salu2

pd.-por cierto sidV .-intente unirme al grupo sin exito ,dice que no tengo permisos suficientes !!!

[Invitado luigi]

Hola Antoni:

Creo que soy el más burro e inútil del mundo, he corrido la macro, se ha generado el Userform con el nombre de todas las hojas pero ahora no soy capaz de hacerlo aparecer, tú me dirás que sigo haciendo mal, perdón por tanta ignorancia.

Te adjunto dos archivos el tuyo original ¿Sigues teniendo problemas con la subida de archivos? y el mío con la macro corrida.

Quedo a la espera de tus sugerencias/enseñanzas.

Un Saludo, El Niño del Video.

Menu Botones Foro Antoni.zip

Menu Botones Foro Luis.zip

[ST_]

hola niño del video:

checa las modificaiones que propuse en el comentario anterior al tuyo,esta basado en la propuesta de Antoni con las sugerencias que ya exprese,espero que con ello no tengas problemas.

recuerda que cuando este abierto el libro debes pulsar Alt+F8 para ver y ejecutar la macro que se muestra en el cuadro de dialogo.

pd-parace que hay problemas para subri archivos !!!

[Invitado luigi]

Hola:

Máster ST Gracias por las enseñanzas, y como parece que vosotros tenéis problemas para las subidas de archivos, ahí va con la macro modificada e insertada pero sin ejecutar.

Un Saludo para Todos, El Niño del Video y Ahora también del Archivo.Luis

Menu Botones Foro.zip

[ST_]

considere algunos otros cambios 'menores'

Sub CrearFormularioMenú

'............

Next m

[COLOR="red"][B]Modificasubrutinas

MsgBox "el formulario se ha creado" 'muestra el mensje

SendKeys "%{F8}"[/B][/COLOR]'muestra el cuadro de dialogo para ejecutar la macro

End Sub[/CODE]

y para que solo se vea al incio la macro que crea al form

[CODE][COLOR="red"][B]Private[/B][/COLOR] Sub AbreFormulario()
UserForm1.Show
End Sub[/CODE]

ademas de la altura de los botones en la macro 'CrearFormularioMenú'

[CODE]With Formulario
............................
.Properties("Height") = Sheets.Count * 25 + 28
End With
.............
.Designer.Controls(Formulario.Designer.Controls.Count - 1).Height = 25
.Designer.Controls(Formulario.Designer.Controls.Count - 1).Top = 2 + 25 * (m - 1)[/CODE]

bueno ahi le dejo por que se me pueden ocurrir mas cosas

[German]

Hola buenos días a tod@s, mi amigo Luis, no te preocupes que aun los hay más verdes que tu en macros, no te das cuen....., que yo ni tan siquiera lo intento, bajé el archivo y tal como lo abrí lo cerre, no tenía ni idea de que hacer con él.

Al final te das cuenta que siempre hay quien es más adelantado que uno, pero también que hay más atrasados que uno.

Un abrazo y muchos ánimos, Germán.

[Antoni]

Vamos por orden:

A _ST: Gracias por las sugerencias, las estudio y te comento.

A Luis: En tu archivo, posicionate encima del formulario, click y F5.

Si quieres hacerlo bonito:

1º) Añade esta macro que muestra el formulario

Sub MostrarFormulario()

Userform1.Show

End sub [/CODE]

2º) Añade una forma o una imagen

3º) Click derecho sobre el objeto, escoge Asignar macro, y escoge la macro MostrarFormulario.

4º) Pulsa sobre el objeto/imagen, y el formulario se ejecutará.

[b]A Agerman[/b]: Abre el archivo que envié, verás que hay un conjunto de hojas, es solo para ver el funcionamiento de la macro, valdria cualquier otro libro.

1º) Pulsa Alt+F8 y ejecuta la macro "CrearFormularioMenú"

Esta macro, genera un formulario (Userform1) como si lo hubieras hecho tu manualmente, verás que hay un botón por cada hoja del libro.

2º) Sigue la respuesta de Luis.

Saludos a todos.

[German]

Hola, he descargado todos los archivos y en todas me da fallo en tiempo de ejecución.

Saludos, Germán.

[Antoni]

Hola a todos:

A Agernan: Si no me dices cual es el error que te da, no puedo ayudarte.

A _ST: Como dicen las frases, "¡ La Imaginación al poder !" y "Contra gustos no hay nada escrito", me parecen muy acertadas tus apreciaciones, solo una cosa a tener en cuenta, no siempre el formulario generado se llamará Userform1, porqué si ya existe un Userform1 en el momento de generar el formulario, entonces se llamaría Userform2, y así sucesivamente. Intenté cambiar el nombre al generarlo, pero me da un error aleatorio "Error 75 no se encuentra la ruta de acceso", y lo dejé por imposible.

Muchas gracias, me quedo con ProcBodyLine y ReplaceLine, metodos de CodeModule que no conocia.

Saludos cordiales. Antoni.

[German]

Gracias Antoni, pues en el archivo que subió Luis llamado Menu Botones Foro Antoni, que entendía que era el último tuyo actualizado, el error es el siguiente cuando intento ejecutar la macro; "Se ha producido el error '1004' en tiempo de ejecución: El acceso mediante programación al proyecto de Visual Basic no es de confianza" y me marca de amarillo ésta linea "Set Formulario = ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)"

Bueno, recibe un cordial saludo, Germán.

[Antoni]

Hola Agerman:

Mirate los posts #8 y#9 que contesté a Luis.

Salu2. Antoni.