Menú de botones

[German]

Ahora sí, muchas gracias Antoni, por fin lo he podido ver, no lo veo tan inutil como tú comentabas, piensa que con esto se le puede dar a un archivo una presentación mucho más profesional, quitando las etiquetas de hojas y utilizando este código.

Un saludo, Germán.

[Antoni]

Hola Germán, me alegro que lo hayas conseguido.

El valor añadido que creo que tiene este aporte es, por un lado, ver las posibilidades del objeto VBProject, y por otro lado te proporciona un formulario con una estructura creada y que se puede utilizar como formulario Menú, añadiéndole otros controles y adaptandolo a tu gusto y a y tus necesidades.

Hasta otra. Salu2. Antoni.

[ST_]

..... 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.

.

en realidad es muy facil de solucionar si usamos la propiedad name del formulario,tal que..al tener un nombre presonalizado,este no generará ningun problema aunque haya mas forms en el VBEditor

Sub CrearFormularioMenú()

Dim Formulario As Object

Dim Boton As MSForms.CommandButton

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

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

With Formulario

     '..........................códig anterior ya comentado

    [COLOR="red"][B][B].Properties("Name") = "MiMenuBotones" 'agregado[/B][/B][/COLOR]

End With[/CODE]

por supuesto habrá que cambiar la rutina que abre el form por su nombre personalizado:

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

caray !!!...creo que si proponermelo sigo realizando cambios en la propuesta inicial.

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

Saludos cordiales. Antoni.

ps de que,para esos estamos para compartir

por cierto muy utiles para localizar una macro y cambiar su 'contenido'

[Antoni]

Hola _ST:

.Properties("Name") = "MiMenuBotones" 'agregado

Ese es el problema, de cada tres veces, mas o menos, que ejecuto la macro con esa propiedad, dos me da el error descrito en mi último post.

No sigue ninguna regla, igual funciona 5 veces seguidas que falla otras 7.

Por eso opté por pasar del tema.

No obstante, gracias por el interés.

Hasta siempre.

Antoni.

[ST_]

No sigue ninguna regla' date=' igual funciona 5 veces seguidas que falla otras 7.[/quote']

pues caray no se me habia ocurrido 'usar mal' las macros (y lo digo con todo respeto por las sig razones)

1.-habrá que considerar que alguna utilida se le puede sacar al tema/propuesta

2.-entonces nadie deberia crea un menu si este ya fue creado !!!!!

3.-con lo cual resulta evidente que le haria falta código para que esto no ocurriera

4.-pero si aun así el programador (llamase cualquiera de nosotros) desea por simple capricho hacerlo,creo que entonces deberiamos considerar código 'adicional' para evitar los errores

para lo cual se debria/podrian hacer los sig cambios:

1.-incluir el evento terminate del formulario para que al cerrarlo se ejecute una rutina que actualice

las macros ya que algunas estan delcaradas como privadas y no se ven el el cuadro de dialogos de macros

"disponibles"

2.-cambiar la proiedad caption del form que se esta creando programaticamente y usar una funcion para

que nos devuelva el nombre del ultimo formulario8es decir el que estoy creando),de esta manera vere

cuantos forms creo en tiempo de ejecucion y los distinguire uno de otro,cosa que no podia hacer al

tener el caption igual todos los forms que voy creando

3.-se modifica la macro que abre el formulario para que simpre abra el recien creado o ultimo

utilizando para ello un código totalmente distinto y la funcion que regresa el nombre del ultimo

form creado

4.-se agrega una cuarta macro que hace lo contrario a la macro "Modificasubrutinas" es decir

regresa las macros a su estado original

5.-se agrega una maro auxiliar que elimina los forms creados durante el ejercicio.-esta no es indispensable

ya que los forms se pueden eliminar manualmente

6.-por ultimo se corrige la seccion que copia los eventos intialize y termimnate a los formularios ya que

copiaban y pegaban lineas de mas (hasta la 19 debiendo ser hasta la 11)

demas decirte que ya tengo probado el código y 'al parecer' se eliminan los errores

me la paso presionando Alt+F8 para mostrar el dialogo y ejecutar las macros y enter para aceptar y Alt+F4 para cerrar cada form creado,de esta forma lo hago hasta

que se me cansan los dedos y desp. simplemente elimino todos los forms excepto el primero .)

[Antoni]

Hola _ST:

Muchas gracias por tus consejos, los tendré en cuenta.

Esto para que no se cansen tus dedos, jajaja

Private Sub BorrarFormulario()

Dim Formulario As Object

Dim Boton As MSForms.CommandButton

On Error Resume Next

For x = __ To __

ActiveWorkbook.VBProject.VBComponents.Remove _

   ActiveWorkbook.VBProject.VBComponents.Item("Userform" & x)

Next x

End Sub[/CODE]

Saludos cordiales. Antoni.

[ST_]

Gracias Antoni

en realidad ya tenia la macro que es muy parecido a tu código,solo que al tener una funcion que me regresa el nombre del ultimo form,puedes encontrar la macro con el nombre "EliminaFormularios"

de paso copio/pego todo(a falta de poder subir el archivo)

los cambios/adiciones ultimas estan marcadas con azul

'APIS BOTONES DE MAXIMIZAR Y MINIMIZAR

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

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

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

Public Const WS_MINIMIZEBOX As Long = &H20000

Public Const WS_MAXIMIZEBOX As Long = &H10000

Public 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

[COLOR="blue"][B]Private Sub UserForm_Terminate()

    Application.Run ("Inviertesubrutinas")

End Sub[/B][/COLOR]

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

' 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

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

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

With Formulario

    .Properties("ShowModal") = False

    .[COLOR="blue"][B]Properties("Caption") = Ultimoform [/B][/COLOR]'"Menú general"

    .Properties("Width") = 128

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

    '.Properties("Name") = "MiMenuBotones"

End With

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

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

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

    .InsertLines .CountOfLines + 1, Desde.Lines([COLOR="blue"][B]11, 11)[/B][/COLOR] 'de la linea 11 copia 11 lineas

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

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

      .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 = 120

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

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

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

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

      .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

    Modificasubrutinas

    MsgBox "el formualrio ha sido creado"

    SendKeys "%{F8}"

End Sub

Private Sub AbreFormulario()

    'MiMenuBotones.Show

    [COLOR="blue"][B]VBA.UserForms.Add(Ultimoform).Show[/B][/COLOR]

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

[COLOR="blue"][B]Private Sub Inviertesubrutinas()

    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, "Sub CrearFormularioMenú"

    localiza.ReplaceLine n2, "Private Sub AbreFormulario"

End Sub[/B][/COLOR]

[COLOR="blue"][B]Function Ultimoform()

Set forms = ActiveWorkbook.VBProject.VBComponents

    For i = 1 To forms.Count

        If forms(i).Type = vbext_ct_MSForm Then

            f = forms(i).Name

        End If

    Next i

        Ultimoform = f

End Function

Private Sub EliminaFormularios()

    Set Formularioa = ActiveWorkbook.VBProject.VBComponents

    ultimo = Val(Right(Ultimoform, 1))

        For i = ultimo To 2 Step -1

            Formularioa.Remove Formularioa(Ultimoform)

        Next i

End Sub[/B][/COLOR][/CODE]

[color=red][b]nota:el requisito previo es que exista por lo menos un formulario ya creado para que corra adecuadamente[/b][/color]

Bajar ejemplo desde este enlace: [b]MenuBotonesST[/b]

[Antoni]

Gracias _ST por tu colaboración.

El aporte ya es mas tuyo que mio.

Saludos cordiales. Antoni.