Macro en excel para pintar objetos
Quiero generar una macro que me pinte un objeto (circulo) tengo alrededor de 20 colores (códigos RGB) y más de 500 círculos, entonces quiero automatizar algo la macro, pero me arroja un error
La macro es la siguiente:
Dim P As String
P = Range("B23").Value
ActiveSheet.Shapes.Range(Array("Oval 25")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = P
La intente de la siguiente manera y si me funciono:
Dim P As String
P = RGB(4, 10, 252)
ActiveSheet.Shapes.Range(Array("Oval 25")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = P
Pero voy a tardar mucho haciendo el código ya que por cada circulo tendría que generar 20 decisiones (seria muy tardado)
Me gustaría que me ayudaran a que funcione la primer opción que les comento, la que me marca error, ya que por medio de excel puedo ir cambiando el código RGB de la variable, solo que ya intente de muchas formas y no logro hacerla que funcione
H o l a:
Pero de qué forma se puede saber que el objeto "Oval 25" va a tomar el valor que está en la celda B23, es decir, cómo saber cuál es la relación de objeto-celda.
En la celda vas a poner algo como esto: RGB(4, 10, 252)
Envíame tu archivo y me explicas con comentarios cómo es la relación.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “chiclesm” y el título de esta pregunta.
Hola de antemano Gracias por contestar
Ya le mande el correo, con un ejemplo de lo que estoy intentando hacer...
Ya que el original lo tengo en mi trabajo, agregue ciertos comentarios para explicar lo que quiero lograr, si tiene alguna idea de hacer estaría excelente, de lo contrario con que me haga funcionar el código que comento yo me hago garras
De antemano Muchas Gracias
Saludos
Hola Dante, quiero agradecerte por tu tiempo y ganas de ayudar, con la macro que me enviaste fue suficiente para ver mi error, ya que yo quería jalar todo el código RGB en una variable y en tu ejemplo vi que generaste una variable por cada letra:
Dim A As String
Dim B As String
Dim C As String
A = Range("B23").value
B = Range("C23").value
C = Range("D23").value
ActiveSheet.Shapes.Range(Array("Oval 25")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(A, B, C)
Esa era la respuesta...
Muchísimas Gracias, por gente como tu esta página es la mejor para consultas
Un abrazo y en cuanto la termine te la envío por correo, para que la veas
Saludos
H o l a:
Anexo el código:
Sub Colores()
'Por.Dante Amor
On Error Resume Next
For i = 15 To 16
o1 = Cells(i, "A")
n1 = Cells(i, "U")
Set b = Columns("CG").Find(n1, lookat:=xlWhole)
If Not b Is Nothing Then
rgbcolor = b.Offset(0, 1)
wcolors = Split(rgbcolor, ",")
r = wcolors(0)
g = wcolors(1)
b = wcolors(2)
End If
ActiveSheet.Shapes.Range(Array("Oval " & o1)).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(r, g, b)
o1 = Cells(i, "B")
n1 = Cells(i, "W")
Set b = Columns("CG").Find(n1, lookat:=xlWhole)
If Not b Is Nothing Then
rgbcolor = b.Offset(0, 1)
wcolors = Split(rgbcolor, ",")
r = wcolors(0)
g = wcolors(1)
b = wcolors(2)
End If
ActiveSheet.Shapes.Range(Array("Oval " & o1)).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(r, g, b)
o1 = Cells(i, "C")
n1 = Cells(i, "Y")
Set b = Columns("CG").Find(n1, lookat:=xlWhole)
If Not b Is Nothing Then
rgbcolor = b.Offset(0, 1)
wcolors = Split(rgbcolor, ",")
r = wcolors(0)
g = wcolors(1)
b = wcolors(2)
End If
ActiveSheet.Shapes.Range(Array("Oval " & o1)).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(r, g, b)
Next
End SubSal u dos
