Macros.Excel.Ejercicios. Coloreando la pantalla

Os presentamos un pequeño ejercicio de excel útil solamente para relajar el tedio del estudio, pero como también eso es importante, podéis copiar esta pequeña macro y observad lo que hace.

La macro empieza borrando contenido y formato de la hoja activa, y a continuación modifica la anchura de las celdas a 2 por 0.2

ActiveSheet.Cells.ClearContents
ActiveSheet.Cells.ClearFormats
Cells.Select
Selection.ColumnWidth = 0.2
Selection.RowHeight = 2

después se mete en un bucle que repetira 10000 veces según está codificado, no os preocupéis mucho, ya que en un ordenador actual no debiera tardar mas de 30 segundo, y si no, siempre podréis abortar la macro.

En fín, para cada pasada coloreara tres celdas aleatorias, cada una con un color, pondrá con fondo blanco 2 y borrara el color de otras tres, vosotros mismos podéis intentar otras combinaciones y colores

For a = 1 To 10000
            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).Interior.Color = RGB(0, 0, 100)
            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).Interior.Color = RGB(255, 255, 255)

            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).Interior.Color = RGB(255, 0, 0)
            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).Interior.Color = RGB(255, 255, 255)
            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).Interior.Color = RGB(0, 255, 0)
            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).ClearFormats

            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).ClearFormats

            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).ClearFormats

      DoEvents
    Next a

la instrucción DoEvents que aparece al final del bucle hace que la macro ceda tiempo al S.O. para que, por ejemplo, se entere que pulsáis el boton de parar…..

A continuación, tenéis toda la macro junta:

Sub rellenando()

    ActiveSheet.Cells.ClearContents
    ActiveSheet.Cells.ClearFormats
    Cells.Select
    Selection.ColumnWidth = 0.2
    Selection.RowHeight = 2
    Cells(1, 1).Select
    For a = 1 To 10000
            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).Interior.Color = RGB(0, 0, 100)
            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).Interior.Color = RGB(255, 255, 255)

            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).Interior.Color = RGB(255, 0, 0)
            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).Interior.Color = RGB(255, 255, 255)
            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).Interior.Color = RGB(0, 255, 0)
            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).ClearFormats

            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).ClearFormats

            x = Int(Rnd * 400) + 1
            y = Int(Rnd * 200) + 1
            Cells(x, y).ClearFormats

      DoEvents
    Next a

End Sub

Por si no lo habéis supuesto, la macro comentada hace algo semejante a esto

Y ahora os dejo otra macro para que averiguéis que es lo que hace

Sub moviendonos()

    ActiveSheet.Cells.ClearContents
    ActiveSheet.Cells.ClearFormats
    Cells.Select
    Selection.ColumnWidth = 0.58
    Selection.RowHeight = 2

    For a = 1 To 100
        Application.ScreenUpdating = False
        For b = 1 To 100
        col = Int(Rnd * 200) + 1
            Cells(1, col).Interior.Color = RGB(0, 0, 100)
        Next
        Cells(1).EntireRow.Insert
        Application.ScreenUpdating = True
    Next a

End Sub