Excel.Macros.Ejercicios. Dibujar espiral

Otra inútil macro de excel… Realmente, su única misión es generarnos en la hoja un cuadrado cuyos lados se van haciendo mas pequeños en cada pasada, y las líneas que lo dibujan van cambiando de color de forma aleatoria. Pero, en un curso de macros, siempre tenemos la excusa de hacer algunas de estas «cosas», porque «asi se practica el lenguaje».

Esta es la imagen que obtendremos, más o menos, y además lo podemos hacer con muy poco esfuerzo; al final del artículo, tenéis la macro utilizada, y en las próximas líneas, intentaré explicar como funciona.

Las prímeras líneas, se dedican a definir las variables que vamos a utilizar, hasta que establecemos el tamaño del dibujo, eso lo hacemos cargando valores a las variables alto y ancho; esos valores, son el número de celdas iniciales (de ancho y de alto), osea que no os paseis intentando indicarle mas celdas de las que tiene excel de ancho y de alto, porque no se filtra nada , y dará error. También os digo que el proceso no está hecho para ir rápido, por lo que si dejais la hoja excel a la vista mientras que se ejecuta la macro, iréis viendo aparecer el dibujo.

Las siguientes líneas, se limitan a borrar cualquier cosa que haya en la hoja, a seleccionarla por completo, para cambiar la altura y anchura de las celdas, y, por último dejamos seleccionada una celda (la 1,1 aunque dá lo mismo la que sea), para desactivar la selección de la hoja entera que habíamos hecho.

Ahora ya estamos apunto para empezar a dibujar,

While alto > 0 And ancho > 0
        offsetHor = 1
        offsetVer = 0
        colorCelda = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
        linea ancho, offsetHor, offsetVer, colorCelda
        ancho = ancho - 1
        offsetHor = 0
        offsetVer = 1

Quien hace realmente la labor de escribir en la celda es la rutina línea

Sub linea(numero, offsetHor, offsetVer, color)

    For a = 1 To numero
        ActiveCell.Interior.color = color
        ActiveCell.Offset(offsetVer, offsetHor).Select
        DoEvents
    Next a

aunque lo hace sin saber absolutamente nada, recibe una celda activa, el número de celdas que ha de colorear, el color que ha de usar, y dos offsets, uno vertical y otro horizontal que aplica cada vez que colorea una celda.

Es la rutina externa que va controlando los colores, generándolos de forma aleatoria, indicando por medio de los offset la dirección en la que se dibujara la línea, y el ancho o alto de la línea, a la vez que les va restando uno, cada vez que dibuja una línea.

El bucle, y el dibujo, finaliza cuando el ancho o el alto alcance cero, ya que significa que ha llegado al centro del dibujo.

A continuación tenéis la macro. Espero que haya quedado un poco claro….

Sub cuadrados()
    Dim alto As Integer
    Dim ancho As Integer
    Dim offsetHor As Integer
    Dim offsetVer As Integer
    Dim a As Integer
    Dim colorCelda As Long

    alto = 200
    ancho = 200

    ActiveSheet.Cells.ClearContents
    ActiveSheet.Cells.ClearFormats
    Cells.Select

    Selection.ColumnWidth = 0.2

    Selection.RowHeight = 2
    Cells(1, 1).Select
    While alto > 0 And ancho > 0
        offsetHor = 1
        offsetVer = 0
        colorCelda = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
        linea ancho, offsetHor, offsetVer, colorCelda
        ancho = ancho - 1
        offsetHor = 0
        offsetVer = 1
        colorCelda = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))

        linea alto, offsetHor, offsetVer, colorCelda
        alto = alto - 1
        offsetHor = -1
        offsetVer = 0
        colorCelda = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
        linea ancho, offsetHor, offsetVer, colorCelda
        ancho = ancho - 1
        offsetHor = 0
        offsetVer = -1
        colorCelda = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
        linea alto, offsetHor, offsetVer, colorCelda
        alto = alto - 1
        DoEvents
    Wend
 End Sub
 Sub linea(numero, offsetHor, offsetVer, color)

    For a = 1 To numero
        ActiveCell.Interior.color = color
        ActiveCell.Offset(offsetVer, offsetHor).Select
        DoEvents
    Next a
End Sub