Macro para poner un cuadrado en una celda

Quiero hacer una macro que me ponga un cuadrado azul en la celda A5, que cubra todo su tamaño de la celda ¿Alguien podria ayudarme?

1 respuesta

Respuesta
1
Te dejo la rutina. No mencionás en qué momento querrás que esto se ejecute, por lo quela dejé apta para ser colocada en un módulo.
Sub MacroCuadrado()
' Macro grabada el 11/05/2008 por Elsamatilde
tope = Range("A5").Top
izq = Range("A5").Left
ancho = Range("A5").Width
alto = Range("A5").RowHeight
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izq, tope, ancho, alto). _
Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12 'color azul
Range("A6").Select    'opcional
End Sub
Reemplazando Range("A5") por Activecell te puede servir para cualquier celda activa.
Gracias por contestar, mira utilizo el Codigo de la siguiente manera:
Sub rectangulo()
If Range("D4") = Range("H2") And Range("E4") = Range("H2") Then
izquierda = Range("H4").Left
arriba = Range("H4").Top
derecha = Range("I4").Left - izquierda
abajo = Range("H5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("H2") And Range("E4") = Range("I2") Then
izquierda = Range("H4").Left
arriba = Range("H4").Top
derecha = Range("J4").Left - izquierda
abajo = Range("H5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("H2") And Range("E4") = Range("J2") Then
izquierda = Range("H4").Left
arriba = Range("H4").Top
derecha = Range("K4").Left - izquierda
abajo = Range("H5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("H2") And Range("E4") = Range("K2") Then
izquierda = Range("H4").Left
arriba = Range("H4").Top
derecha = Range("L4").Left - izquierda
abajo = Range("H5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("H2") And Range("E4") = Range("L2") Then
izquierda = Range("H4").Left
arriba = Range("H4").Top
derecha = Range("M4").Left - izquierda
abajo = Range("H5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("H2") And Range("E4") = Range("M2") Then
izquierda = Range("H4").Left
arriba = Range("H4").Top
derecha = Range("N4").Left - izquierda
abajo = Range("H5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("H2") And Range("E4") = Range("N2") Then
izquierda = Range("H4").Left
arriba = Range("H4").Top
derecha = Range("O4").Left - izquierda
abajo = Range("H5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("H2") And Range("E4") = Range("O2") Then
izquierda = Range("H4").Left
arriba = Range("H4").Top
derecha = Range("P4").Left - izquierda
abajo = Range("H5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("H2") And Range("E4") = Range("P2") Then
izquierda = Range("H4").Left
arriba = Range("H4").Top
derecha = Range("Q4").Left - izquierda
abajo = Range("H5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("I2") And Range("E4") = Range("I2") Then
izquierda = Range("I4").Left
arriba = Range("I4").Top
derecha = Range("J4").Left - izquierda
abajo = Range("I5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("I2") And Range("E4") = Range("J2") Then
izquierda = Range("I4").Left
arriba = Range("I4").Top
derecha = Range("K4").Left - izquierda
abajo = Range("I5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("I2") And Range("E4") = Range("K2") Then
izquierda = Range("I4").Left
arriba = Range("I4").Top
derecha = Range("L4").Left - izquierda
abajo = Range("I5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("I2") And Range("E4") = Range("L2") Then
izquierda = Range("I4").Left
arriba = Range("I4").Top
derecha = Range("M4").Left - izquierda
abajo = Range("I5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("I2") And Range("E4") = Range("M2") Then
izquierda = Range("I4").Left
arriba = Range("I4").Top
derecha = Range("N4").Left - izquierda
abajo = Range("I5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("I2") And Range("E4") = Range("N2") Then
izquierda = Range("I4").Left
arriba = Range("I4").Top
derecha = Range("O4").Left - izquierda
abajo = Range("I5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("I2") And Range("E4") = Range("O2") Then
izquierda = Range("I4").Left
arriba = Range("I4").Top
derecha = Range("P4").Left - izquierda
abajo = Range("I5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("I2") And Range("E4") = Range("P2") Then
izquierda = Range("I4").Left
arriba = Range("I4").Top
derecha = Range("Q4").Left - izquierda
abajo = Range("I5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("J2") And Range("E4") = Range("J2") Then
izquierda = Range("J4").Left
arriba = Range("J4").Top
derecha = Range("K4").Left - izquierda
abajo = Range("J5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("J2") And Range("E4") = Range("K2") Then
izquierda = Range("J4").Left
arriba = Range("J4").Top
derecha = Range("L4").Left - izquierda
abajo = Range("J5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("J2") And Range("E4") = Range("L2") Then
izquierda = Range("J4").Left
arriba = Range("J4").Top
derecha = Range("M4").Left - izquierda
abajo = Range("J5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("J2") And Range("E4") = Range("M2") Then
izquierda = Range("J4").Left
arriba = Range("J4").Top
derecha = Range("N4").Left - izquierda
abajo = Range("J5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("J2") And Range("E4") = Range("N2") Then
izquierda = Range("J4").Left
arriba = Range("J4").Top
derecha = Range("O4").Left - izquierda
abajo = Range("J5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("J2") And Range("E4") = Range("O2") Then
izquierda = Range("J4").Left
arriba = Range("J4").Top
derecha = Range("P4").Left - izquierda
abajo = Range("J5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("J2") And Range("E4") = Range("P2") Then
izquierda = Range("J4").Left
arriba = Range("J4").Top
derecha = Range("Q4").Left - izquierda
abajo = Range("J5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("K2") And Range("E4") = Range("K2") Then
izquierda = Range("K4").Left
arriba = Range("K4").Top
derecha = Range("L4").Left - izquierda
abajo = Range("K5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("K2") And Range("E4") = Range("L2") Then
izquierda = Range("K4").Left
arriba = Range("K4").Top
derecha = Range("M4").Left - izquierda
abajo = Range("K5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("K2") And Range("E4") = Range("M2") Then
izquierda = Range("K4").Left
arriba = Range("K4").Top
derecha = Range("N4").Left - izquierda
abajo = Range("K5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("K2") And Range("E4") = Range("N2") Then
izquierda = Range("K4").Left
arriba = Range("K4").Top
derecha = Range("O4").Left - izquierda
abajo = Range("K5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("K2") And Range("E4") = Range("O2") Then
izquierda = Range("K4").Left
arriba = Range("K4").Top
derecha = Range("P4").Left - izquierda
abajo = Range("K5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("K2") And Range("E4") = Range("P2") Then
izquierda = Range("K4").Left
arriba = Range("K4").Top
derecha = Range("Q4").Left - izquierda
abajo = Range("K5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("L2") And Range("E4") = Range("L2") Then
izquierda = Range("L4").Left
arriba = Range("L4").Top
derecha = Range("M4").Left - izquierda
abajo = Range("L5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("L2") And Range("E4") = Range("M2") Then
izquierda = Range("L4").Left
arriba = Range("L4").Top
derecha = Range("N4").Left - izquierda
abajo = Range("L5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("L2") And Range("E4") = Range("N2") Then
izquierda = Range("L4").Left
arriba = Range("L4").Top
derecha = Range("O4").Left - izquierda
abajo = Range("L5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("L2") And Range("E4") = Range("O2") Then
izquierda = Range("L4").Left
arriba = Range("L4").Top
derecha = Range("P4").Left - izquierda
abajo = Range("L5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("L2") And Range("E4") = Range("P2") Then
izquierda = Range("L4").Left
arriba = Range("L4").Top
derecha = Range("Q4").Left - izquierda
abajo = Range("L5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("M2") And Range("E4") = Range("M2") Then
izquierda = Range("M4").Left
arriba = Range("M4").Top
derecha = Range("N4").Left - izquierda
abajo = Range("M5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("M2") And Range("E4") = Range("N2") Then
izquierda = Range("M4").Left
arriba = Range("M4").Top
derecha = Range("O4").Left - izquierda
abajo = Range("M5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("M2") And Range("E4") = Range("O2") Then
izquierda = Range("M4").Left
arriba = Range("M4").Top
derecha = Range("P4").Left - izquierda
abajo = Range("M5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("M2") And Range("E4") = Range("P2") Then
izquierda = Range("M4").Left
arriba = Range("M4").Top
derecha = Range("Q4").Left - izquierda
abajo = Range("M5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("N2") And Range("E4") = Range("N2") Then
izquierda = Range("N4").Left
arriba = Range("N4").Top
derecha = Range("O4").Left - izquierda
abajo = Range("N5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("N2") And Range("E4") = Range("O2") Then
izquierda = Range("N4").Left
arriba = Range("N4").Top
derecha = Range("P4").Left - izquierda
abajo = Range("N5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("N2") And Range("E4") = Range("P2") Then
izquierda = Range("N4").Left
arriba = Range("N4").Top
derecha = Range("Q4").Left - izquierda
abajo = Range("N5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("O2") And Range("E4") = Range("O2") Then
izquierda = Range("O4").Left
arriba = Range("O4").Top
derecha = Range("P4").Left - izquierda
abajo = Range("O5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("O2") And Range("E4") = Range("P2") Then
izquierda = Range("O4").Left
arriba = Range("O4").Top
derecha = Range("Q4").Left - izquierda
abajo = Range("O5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
Else
If Range("D4") = Range("P2") And Range("E4") = Range("P2") Then
izquierda = Range("P4").Left
arriba = Range("P4").Top
derecha = Range("Q4").Left - izquierda
abajo = Range("P5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 3
Selection.Name = "Rectángulo"
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End Sub
 El archivo ejemplo lo tengo en el siguiente link:
http://www.4shared.com/account/dir/4632746/5be22962/sharing.html?rnd=92
Como puedes ver repito mucho la formula y eso que solo uso un renglon con 9 columnas y mi necesidad es de varios renglones y varias columnas
En la celda D4 he puesto una fecha (solo una entre el 01-May y el 09 de Mayo) y en la celda E4 he hecho lo mismo, en H2 dice 01-May, en I2 dice 02-May, en J2 dice 03-May, K2 04-May, L2 05-May, M2 06-May, N2 07-May, O2 08-May y P2 dice 09-May.
Pues pues lo que yo hago es que si la fecha de D4 y E4 se encuentra en el rango de H2 a P2, deseo que me ponga el rectangulo en la misma fila 4, el archivo del link hace lo que deseo, pero quisiera saber si existe un modo mas breve, ya que lo ocupare en archivos con bastantes renglones y columnas
¿Puedes ayudarme?
Desde ya muchas gracias
Atte. Jonathan
Gracias por contestar, mira utilizo el Codigo de la siguiente manera:
El archivo ejemplo lo tengo en el siguiente link:
http://www.4shared.com/account/dir/4632746/5be22962/sharing.html?rnd=92
Como puedes ver repito mucho la formula y eso que solo uso un renglon con 9 columnas y mi necesidad es de varios renglones y varias columnas
En la celda D4 he puesto una fecha (solo una entre el 01-May y el 09 de Mayo) y en la celda E4 he hecho lo mismo, en H2 dice 01-May, en I2 dice 02-May, en J2 dice 03-May, K2 04-May, L2 05-May, M2 06-May, N2 07-May, O2 08-May y P2 dice 09-May.
Pues pues lo que yo hago es que si la fecha de D4 y E4 se encuentra en el rango de H2 a P2, deseo que me ponga el rectangulo en la misma fila 4, el archivo del link hace lo que deseo, pero quisiera saber si existe un modo mas breve, ya que lo ocupare en archivos con bastantes renglones y columnas
¿Puedes ayudarme?
Desde ya muchas gracias
Atte. Jonathan
Cualquiera que lea tu consulta original y mi respuesta verá que la consulta ha sido correctamente respondida y por ende debiera ser finalizada.
En lugar de eso me devolvés una rutina que además de extensa, no utiliza las instrucciones que te he dado, por lo que no sé si lo que te diga ahora lo harás o no.
Para abreviar quita las líneas que yo no te incluí en la respuesta. Y para poder utilizar la rutina en otras filas deberás reemplazar la referencia (Range("D4").select , o la fila que corresponda) por la celda activa, llamada Activecell para indicar la primera (en lugar de Range("D4"), Activecell. Offset(0,1) para indicar la siguiente, es decir Range("E4") y así con todas.
Además debieras utilizar un bucle que recorra la fila hasta llegar a la última col. Según tu ejemplo seá T = 20. comenzando en F  = 6
EJEMPLO:
Sub dibuja()
If Range("D4") = Range("H2") Then 
fila = 2
col = 6
While col <= 20 'si llegará hasta col T
If Range("E4") = Cells(fila, col) Then
'TUS INSTRUCCIONES DE DIBUJO
izquierda = Range("O4").Left
arriba = Range("O4").Top
derecha = Range("P4").Left - izquierda
abajo = Range("O5").Top - arriba
ActiveSheet.Shapes.AddShape(msoShapeRectangle, izquierda, arriba, derecha, abajo).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
'SIGUEN MÁS INSTRUCCIONES DE DIBUJO
col = col + 1
Wend
End Sub
Hola
Ofrezco mil disculpas, desconozco este sistena crei que era como una especie de chat y asi hubiera seguido sin darme cuenta efectivamente tu respuesta fue correcta al hacer exactamente lo que yo pedi y la segunda la probare enseguida, pues a simple vista mejora en mucho mi cpdigo antes expuesto en cuanto a minimo tamaño respecta.
Te agradezco la atencion que te tomaste al contestar y por haberlo hecho correctamente
Me agradaria corresponder de algun modo
Saludos y Gracias.
Jonathan

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Insertar, modificar y posicionar autoformas VBA

Quiero insertar las siguientes autoformas mediante código: Flecha vertical señalando hacia arriba Flecha horizontal señalando hacia la derecha Rectángulo vertical Rectángulo horizontal Después modificar su color y colocarlos en zonas concretas de un...
1 respuesta

¿Cómo cambiar contorno autoforma macro?

Quisiera saber la forma de cambiar el contorno de una autoforma por medio de una macro, pues ya he logrado darle nombre y cambiarle el color de relleno, pero no he encontrado la forma de cambiarle su contorno. A continuación el código que he logrado...
1 respuesta

Crear botón de comando que muestre/oculte imagen

Me gustaría crear un botón de comando que tras pulsarle una vez me mostrara una imagen (que ya tengo en el disco duro) y que cuando le pulse otra vez la oculte. Para mostrarlo ya encontré el código pero no se como hacer para que tras pulsar de nuevo...
1 respuesta

Fotos en excel con macro, pesa mucho archivo final

Lo que busco es hacer un formulario que me ubique por fotos en una hoja, las imágenes están en una carpeta definida, tengo el siguiente código (lineas abajo), pero, el resultado es un archivo demasiado grande, tanto que cuelga mi maquina, y estoy...
1 respuesta

Hacer Un Rectángulo con una Macro

Quería saber si existe alguna manera de crear un rectángulo con una macro y asignarles las medidas por medio de dos celdas
1 respuesta

Insertar foto condicionada a un valor

Estoy intentando insertar una foto que dependa de la calificación en un cuestionario; he usado las macros de Dan que he visto publicadas pero no me jalan y no encuentro el error, ¿Me podrían apoyar? Sub insertarfoto() 'pone la imagen según un número...
1 respuesta

Borrar con Macros Gráfico incrustado

He realizado una macros en excel a través del grabador de macros en donde pretendo borrar un gráfico incrustado creado en una hoja1, el problema es que, cuando pretendo ejecutar la macros me aparece el siguiente error: Se ha producido un error '1004'...
1 respuesta