LLAMAR UN MISMO FORMULARIO CON INFINITOS BOTONES EN UNA HOJA

marroco312 · el 24 de febrero

Buenas noches a todos, Gracias por los aportes que me han brindado han sido de mucha utilidad

Hoy traigo un tema que espero me puedan colaborar tengo una hoja con N cantidad de botones lo que requiero es que cuando le de clck en el botón me llame el formulario y en le etiqueta salga el nombre del Botón, se que es algo muy simple si en cada botón agrego el mismo código pero hablemos de 500 o mas botones se vuelve tedioso, lo que deseo es que cuando agregue mas botones no tenga que seguir colocando el mismo código que se vuelve repetitivo hay alguna alternativa para realizar esta misma función.

saludos,

Macro llamar formulario.xlsm

ikanni · el 24 de febrero

Hola Marroco,

Yo lo que haría sería un procedimiento al que llamarian todos los botones. Y cómo parametro el nº del boton. QUiero decir:

Procedimiento:

Sub llamadaBoton(NoBoton As Integer)
...
End Sub

LLamarlo desde el boton (Por ejemplo 502)

Call llamadaBoton(502)

Saludos

Ikanni

logroastur · el 24 de febrero

Buenas @marroco312

Puedes usar

Sub GetAddButons()
    Dim btn As Object
    Dim rng As Range
    Dim i   As Long
    Dim n   As Long
    Set rng = Hoja1.Range("B3")
    For i = 1 To 30 Step 3
        n = n + 1
        Set btn = ThisWorkbook.Sheets(rng.Parent.Name).Buttons.Add(rng(i, 1).Left, _
                                                                   rng(i, 1).Top, _
                                                                   rng(i, 1).Width, _
                                                                   rng(i, 1).RowHeight * 1.5)
        With btn
            .OnAction = ThisWorkbook.Name & "!GetButtonName"
            .Caption = "Es el " & n
            .Name = "Boton" & n
        End With
        Set btn = Nothing
    Next
    Set rng = Nothing
End Sub
Sub GetButtonName(Optional strSP As String = "#")
    Dim sp As Shape
    Dim d  As String
    If strSP = "#" Then
        d = Application.Caller
    Else
        d = strSP
    End If
    On Error Resume Next
    Set sp = Hoja1.Shapes(d)
    If Not sp Is Nothing Then
        With sp.OLEFormat.Object
           d = "Presionado el botón " & vbNewLine & vbTab & _
              "Nombre " & d & vbNewLine & vbTab & _
              "Valor  " & .Caption & vbNewLine & vbTab & _
              "Teniendo el Indicador " & .Index
        End With
        MsgBox d, vbInformation, Application.OrganizationName
    Else
        If Err.Number <> 0 Then
            MsgBox "Error Nº" & Err.Number & vbNewLine & Err.Description, vbCritical, Application.OrganizationName
        Else
            MsgBox "No se uso un buton", vbExclamation, Application.OrganizationName
        End If
    End If
    Set sp = Nothing
    On Error GoTo 0
End Sub

Solo debes de colocar estos códigos en un nuevo archivo y ejecuta el código GetAddButons, creara 10 botones y luego usa cada uno de ellos, se mostrara el nombres del botón, texto que se muestra y el número indice en la hoja

Un saludo

Antoni · el 24 de febrero

Usa botones de formulario en lugar de botones ActiveX y asígnales a todos la macro ProcesoBotón (Selecciona el botón\Click derecho\Asignar macro). El formulario se mostrará con el texto del botón en el Label1. Te dejo un ejemplo.

Sub ProcesoBotón()
ActiveSheet.Shapes(Application.Caller).Select
UserForm1.Label1 = Selection.Characters.Text
ActiveCell.Select
UserForm1.Show
End Sub

Aunque no se me ocurre nada que necesite 500 botones. Si explicas con mas detalle lo que pretendes hacer, seguro que hay una solución mas eficaz.

Macro llamar formulario.xlsm

marroco312 · el 25 de febrero

Hola @Macro Antonio

lo que estoy haciendo es un mini programa de Preguntas, para la universidad, mas o menos imitando al programa de quien quiere ser millonario,

saludos,

Antoni · el 25 de febrero

Sube tu archivo y le echaré un vistazo cuando pueda.

marroco312 · el 25 de febrero

Buen dia;

No me dejo cargar el archivo así que lo subí a dropbox, es una parte del archivo para que no me pese tanto.

saludos.

https://www.dropbox.com/home/Decretos?preview=Juego+de+preguntas+V3.6.xlsm

Antoni · el 25 de febrero

No permite descargar el archivo. Pon el archivo en el directorio Public de DropBox, click derecho sobre el archivo, copiar enlace público y luego lo pegas aquí.