onAction o como asignar macros en forma dinamica

He recibido una consulta mas que interesante: un lector está desarrollando un proyecto muy dinámico, el cual debe asignar macros a distintos objetos luego de crearlos. Dichos objetos son las famosas "Autoformas",  presentes en el menú "Insertar / Imagen / Autoforma", conocidas en el ámbito de VBA como "Shapes" Recordemos que, en un 99,99% de los casos, grabamos y/o codificamos una macro, luego insertamos la Autoforma y por último le asignamos la macro en cuestión. Todo ello en forma manual. Mi lector necesita otra cosa: las macros ya están listas, pero desea insertar insertar una Shape y luego asignarle la macro... Todo ello mediante código. Veamos como.

pequeño ejemplo de las Shapes de Excel

[+/-] Ver el resto / Ocultar

Como sabemos, haciendo click con el botón derecho del mouse sobre una Autoforma, podemos vincularlas a distintas macros que tengamos grabadas, lo que nos permitirá que dichas macros se ejecuten toda vez que se realice el click sobre la figura. Es una buena opción a la hora de darle un mejor impacto visual a nuestro proyecto, prescindiendo así de los aburridos y grises botones del cuadro de herramientas "Formulario".

ahá, este es el aburrido control al que hacía referencia.

El proyecto consta de cinco Shapes, las cuales deberemos crear y colocar en la hoja, vinculándoles una macro a cada una. Pasos a seguir:

1) Verificar si en la hoja activa existen autoformas

2) Si el punto 1 es afirmativo, eliminarlas

3) Crear una Shape

4) Situarla en un lugar predeterminado de la hoja

5) Asignarle una macro

6) Repetir este proceso hasta alcanzar las 5 Shapes en la hoja

El objeto Shape admite variantes en su propiedad "tipo" (type). El cambio en esta propiedad nos devolverá una forma distinta de la otra (rectángulo: msoShapeRectangle, cara sonriente: msoShapeSmileyFace, triángulo  isósceles: msoShapeIsoscelesTriangle, etc, etc, etc) Podemos buscar en la web sobre estos tipos, o bien tomarnos el trabajo de ir insertándolos mientras grabamos una macro y ver que nombre le da VBA a cada una de ellas. Como hoy tuve muy buenas noticias, y estoy contento, usaré el tipo msoShapeSmileyFace para elaborar el proyecto.

El código para insertar una Shape es muy sencillo:

Sub PrimerCaraSonriente()
'se utiliza el método AddShape:
'primer argumento: tipo de figura
'segundo / quinto argumento: tamaño
    ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 50, 50, 50, 50).Select
End Sub

El Sub arriba detallado nos arrojará el siguiente resultado:

es poco aún, pero algo es algo

Ahora colocaremos esa autoforma en un lugar específico de la hoja:

Sub PrimerCaraSonriente()
'se utiliza el método AddShape:
'primer argumento: tipo de figura
'segundo --> quinto argumento: tamaño
    ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 50, 50, 50, 50).Select
    With Selection
        '10 unidades para la distancia entre el borde superior
        'y el izquierdo:
        .Top = 10
        .Left = 10
    End With
End Sub

ya podemos ver como la ubicamos donde queremos, sus coordenadas son distintas a la de la imagen anterior.

Sigamos, aún nos resta lo mas importante: asignarle una macro. Supongamos (y espero sepan apreciar el esfuerzo que puse en el código que detallo a continuación) que elaboramos este sub:

Sub MensajePobre()
'que desperdicio de neuronas......
MsgBox "Hola, es la hora " & Format(Time, "hh:mm:ss"), vbInformation
End Sub

y el espectacular código arriba descrito debemos vincularlo a la carita sonriente. Para ello existe el método: onAction = "NombreDelProcedimiento" (si, entre comillas)

Sub PrimerCaraSonriente()
'se utiliza el método AddShape:
'primer argumento: tipo de figura
'segundo --> quinto argumento: tamaño
    ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 50, 50, 50, 50).Select
    With Selection
        '10 unidades para la distancia entre el borde superior
        'y el izquierdo:
        .Top = 10
        .Left = 10
        .OnAction = "MensajePobre"
    End With
End Sub

Y al hacer click sobre la figura que acabamos de crear:

Estamos llegando a buen puerto. Para cumplir totalmente con los requisitos todo esto debería estar dentro de un bucle y así colocar 5 (o las que sean) autoformas. Ojo acá que la posición, por lo menos vertical, de cada figura deberá ir variando, para no superponerlas:

Sub CarasSonrientes()
'variables de uso local
Dim X As Byte
Dim Arriba, Izquierda As Integer

'partimos de un top y un left de 10 unidades:
Arriba = 10
Izquierda = 10

For X = 1 To 5
    ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 50, 50, 50, 50).Select
    With Selection
        '10 unidades para la distancia entre el borde superior
        'y el izquierdo:
        .Top = Arriba
        .Left = Izquierda
        'incremento el top para que la próxima shape se ubique 55 unidades
        'mas abajo que la anterior
        Arriba = Arriba + 55
        'le damos un nombre único para diferenciarla del resto:
        .Name = "CaraSonriente" & X
        'y le asignamos la macro
        .OnAction = "MensajePobre"
    End With
Next X
End Sub

Y si... ya casi estamos:

Tenemos las cinco caras sonrientes, cada una en la posición indicada. El único problema es que las cinco ejecutan la misma macro "MensajePobre". Existen varias formas de solucionar esto, pero mi preferida es crear una tabla (en una hoja separada, para mantener cierto orden) con los nombres de las macros e ir vinculándolas dentro del bucle. Insertamos una nueva hoja y la llamamos: "Procedimientos". A partir de A1 escribiremos las 5 macros:

esta es una forma fácil y rápida de controlar y mantener las macros existentes

Luego, y a medida que se creen las figuras, asignamos las macros de la siguiente forma:

Sub CarasSonrientes()

'variables de uso local
Dim X As Byte
Dim Arriba, Izquierda As Integer
Dim SubAsignado As String


'partimos de un top y un left de 10 unidades:
Arriba = 10
Izquierda = 10
For X = 1 To 5
    ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 50, 50, 50, 50).Select
    With Selection
        '10 unidades para la distancia entre el borde superior
        'y el izquierdo:
        .Top = Arriba
        .Left = Izquierda
        'incremento el top para que la próxima shape se ubique 55 unidades
        'mas abajo que la anterior
        Arriba = Arriba + 55
        'le damos un nombre único para diferenciarla del resto:
        .Name = "CaraSonriente" & X
        'almaceno en la variable el nombre de la macro:
        SubAsignado = Sheets("Procedimientos").Cells(X, 1).Value
        'y la vinculo al objeto:
        .OnAction = SubAsignado
    End With
Next X
End Sub

holaaaa

De esta forma: creamos las macros, escribimos sus nombres en la hoja "Procedimientos" y luego se asignan a cada Shape dentro del For.... Next. Obviamente que existen muchas formas de llevar a cabo esta tarea, pero mi intención es mostrar una de las mas sencillas.

Recordarán que al principio de la entrada mencioné que primero es conveniente eliminar cualquier figura que exista en la hoja, para evitar duplicaciones o errores. Este es el código que lleva a cabo la mencionada acción:

Sub BorrarAutoFormas()

'creo la variable de objeto
Dim sh As Shape

'si NO existen figuras, salgo del sub
If ActiveSheet.Shapes.Count = 0 Then
    GoTo salida
    Exit Sub
End If

'si hay alguna shape en la hoja la
'elimino:
For Each sh In ActiveSheet.Shapes
    sh.Delete
Next sh
'y siempre destruyo el objeto, para liberar
'recursos del sistema
salida:
Set sh = Nothing
End Sub

Podríamos agregar algún procedimiento que le dé color a las Shapes, como el siguiente, el cual se deberá colocar dentro del bucle, luego de haber creado la figura:

Sub Colorear()
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 44
    Selection.ShapeRange.Fill.OneColorGradient msoGradientHorizontal, 2, 0.24
End Sub

Con SchemeColor (44 en este caso) le doy una coloración azul... pero también sería bueno que dicho color pueda ir cambiando..... y eso se los dejo a Uds. =)

Como siempre en estos casos, les dejo el link al archivo
Salu2.xlsx