Macro que cambie el color de una autoforma según condición

Con esta macro que es parecida a su anterior pregunta. Considere lo siguiente:

Si el valor de la celda tiene diferente al numero 1 la forma la dejará transparente, si quiere que unicamente sea el numero 1 la macro le funcionara, en caso de que se cualquier dato alfanumérico la cambia la linea de la condición

If Range("E5").Value = 1 Then

Sub Camb_Color()
'Cambia color forma Triangulo
    With Range("E5").Interior
    clr = Range("E5").Interior.Color
        If Range("E5").Value = 1 Then
            ActiveSheet.Shapes(1).Select
            Selection.Interior.Color = clr
        Else
        'Queda transparente
            ActiveSheet.Shapes(1).Select
            Selection.Interior.Pattern = xlNone
             .TintAndShade = 0
             .PatternTintAndShade = 0
        End If
    End With
End Sub

Estimado funciona perfecto!, ahora te consulto, existe la manera de que la macro se ejecute al colocar el numero o al borrarlo, es decir que el triangulo se pinte cuando pongo un numero en la celda y quede transparente al borrarlo.

Muy agradecido por tu aporte

Nada más ocupara números en esa celda o también letras o símbolos(., -? = ) etc, y como se comportara en esos casos?

Solo números

"Al escribir un numero dentro de la celda la autoforma debe tomar el color que tiene la celda y si borro el numero la autoforma debe quedar transparente."

Para que funcione en automático al capturar un número en la celda E5. Pon el siguiente código en los eventos de tu hoja

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address(0, 0) = "E5" Then
    If Target.CountLarge > 1 Then Exit Sub
    ActiveSheet.Shapes("Triangulo").Fill.Transparency = (Target.Value = "") * -1
    ActiveSheet.Shapes("Triangulo").Fill.ForeColor.RGB = Range("E5").Interior.Color
  End If
End Sub

Sigue las Instrucciones para poner la macro en los eventos de worksheet

1. Abre tu libro de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
4. En el panel del lado derecho copia el código.

Listo, escribe un número en la celda E5, la forma debe cambiar de color. Si borras el número la forma queda transparente.

Cambiar "Triangulo" por el nombre de tu forma.

Estimado Dante, debo realizar un paso más para asignar la macro, porque realice los pasos indicados por Usted pero no se ejecuta. Entiendo que solo debo pegar la macro en la hoja de trabajo, ¿sin necesidad de otra macro creada en un modulo?

Gracias

Así es, no requieres de otra macro.

El código que te envié debe ir en los eventos de la hoja.

Otra forma de llegar a los eventos de la hoja es:

- En la hoja donde quieres que funcione el código, presiona clic derecho en la pestaña donde está el nombre de la hoja.

- Del menú, selecciona la opción Ver código

En el panel pegas la macro

Listo, regresa a la hoja, captura un número en la celda y en automático se pone el color.

Si no se ejecuta, puede ser que tienes los eventos deshabilitados. Entonces en un módulo pon el siguiente código y lo ejecutas.

Sub en()
  Application.EnableEvents = True
End Sub

Regresa a la hoja y escribe un número en la celda E5

Funciono perfecto!, ahora para terminar con este tema, puedo repetir el código en la misma hoja para trabajar con más figuras, ¿cada una con su celda? O solo funciona para una sola autoforma

Mucha pero muchas gracias!

Algo como esto

Asigna una celda a cada nombre de figura en el siguiente código.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("E5, G5, I5")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    Dim xShape As String
    Select Case Target.Address(0, 0)
      Case "E5": xShape = "Triangulo"
      Case "G5": xShape = "Triangulo2"
      Case "I5": xShape = "Triangulo3"
    End Select
    ActiveSheet.Shapes(xShape).Fill.Transparency = (Target.Value = "") * -1
    ActiveSheet.Shapes(xShape).Fill.ForeColor.RGB = Target.Interior.Color
  End If
End Sub

Excelente Dante, sos un genio! Puedo agregar la cantidad de figuras que desee en la hoja de trabajo, ¿o tiene algún limite este comando?

Puedes agregar todas las que quieras.

¡Gracias! Me sera de mucha utilidad tu aporte

Un afectuoso saludo!

Un placer ayudarte ¡Gracias! Por comentar.

Hola Dante, aplique en la planilla que estoy haciendo la macro que me indicaste pero solo me permitió repetirla 44 veces, luego me da error, hay alguna manera para poder replicarla más veces, la verdad es que es perfecta para el trabajo que estoy haciendo, pero necesito que funcione con al menos 100 figuras.

Un afectuoso saludo, muchas gracias

Qué error te envía y cuál línea.

Cada vez que tengas un problema con una macro debes reportar el mensaje de error y la línea que tiene el problema, no es suficiente con decir: "me da error".

Esto ayudará a recibir una ayuda más rápida y más puntual.

Cuáles son las celdas a cambiar, es decir, todas están en la misma fila, o en una misma columna, es un rango de celdas, ¿por ejemplo de E5 hasta E105?

If Not Intersect(Target, Range("E5, G5, I5")) Is Nothing Then

Cuáles son los nombres de las figuras y su relación con la celda, es decir, la E5 es para la fig1, la E6 es para la fig2, la E7 es para fig3, etc.

Dame varios ejemplos de cómo es la relación para preparar algo automático.

Gracias por tu pronta respuesta, te adjunto el error, ¿y para que entiendas mejor la planilla te puedo enviar el archivo a alguna dirección de correo o debo explicarte por este medio solamente? Si borro la ultima celda (que es la N°45) comienza a funcionar nuevamente

S

Por este medio. Y debes responder a todo lo que te solicito.

Debes reportar el mensaje de error y la línea que tiene el problema, no es suficiente con decir: "me da error".

Cuáles son los nombres de las figuras y su relación con la celda, es decir, la E5 es para la fig1, la E6 es para la fig2, la E7 es para fig3, etc.

Dame varios ejemplos de cómo es la relación para preparar algo automático.

OK, te adjunto otra imagen donde podes observar donde aplico la macro, las celdas que están recuadradas en rojo son donde coloco o saco los números para que las figuras que están en los recuadros mayores tomen el color seleccionado o queden transparentes. Cada recuadro mayor tiene 9 figuras. En total son 10 recuadros mayores con 9 figuras cada uno, en total 90 veces debería poder replicar el comando. Como se puede observar las celdas no llevan un orden lineal.

Ojala haya podido brindarte toda la información que necesitas!

No veo un patrón en tus celdas. Tal si me dice en cuáles filas pones los números.

O prueba con este código, te puse unos ejemplos para que completes todas tus celdas:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range
  Dim r5 As Range, r6 As Range, r7 As Range, r8 As Range
  Dim rs
  '
  Set r1 = Range("AV48, AV49, AW48, AX49, AY49, AZ49")
  Set r2 = Range("BA49, BB49, BC49, BO48, BO49, BN49")
  Set r3 = Range("E5, G5, I5")
  Set rs = Union(r1, r2, r3)
  If Not Intersect(Target, rs) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    Dim xShape As String
    Select Case Target.Address(0, 0)
      Case "E5": xShape = "Triangulo"
      Case "G5": xShape = "Triangulo2"
      Case "I5": xShape = "Triangulo3"
      Case Else: Exit Sub
    End Select
    ActiveSheet.Shapes(xShape).Fill.Transparency = (Target.Value = "") * -1
    ActiveSheet.Shapes(xShape).Fill.ForeColor.RGB = Target.Interior.Color
  End If
End Sub

Si las celdas o los nombres de las figuras cambian regularmente, entonces habría que pensar en poner las celdas y los nombres de las figuras en una hoja y adaptar la macro para que haga las lecturas de la hoja.

¡Gracias Dante! Aplique la modificación que me brindaste y esta funcionando correctamente! Son admirables tus conocimientos y la rapidez con que brindas las soluciones!

Muy agradecido