Montaña Rusa Excel Roller Coaster

Posted on junio 06, 2022 by Excel Pedro Wave

¿Una montaña rusa en Excel?

Hace años me hice amigo de George Lungu, cuando me enteré por casualidad que era el autor de una hoja con una "roller coaster" en inglés, o sea una "montaña rusa" en español (¿ahora se debería decir "montaña ucraniana"?) hecha enteramente en Excel y con unas pocas macros.

¡IMPRESIONANTE! ¡ASOMBROSA! ¡EXCELENTE!

Cuando George Lungu comenzó a publicar su blog hace 11 años, escribí el siguiente artículo maravillado por su gran talento:

Excel Unusual Engineering | #ExcelPedroWave

Este es el aspecto de la "montaña rusa":

¡Una montaña rusa en Excel!

Hace unos días carlos barboza publicó un vídeo con la "montaña rusa" en este enlace:

A 3D Animated Roller Coaster Model on spreadsheet | carlos barboza | LinkedIn

El autor del vídeo original George Lungu comentó lo siguiente:

En el nuevo Excel es bastante lento (alrededor de 4 veces más lento que en el antiguo Excel 2003). Tendré que rehacerlo sin el gráfico, redefiniendo los vértices y los segmentos entre ellos como segmentos libres. (no en un gráfico) durante cada fotograma. Eso debe acelerarlo considerablemente. Ustedes me dieron algo que hacer :).

Le comenté lo siguiente:

George Lungu, no necesitas rehacer nada. En Excel para Microsoft 365 funciona bien y tarda menos de un minuto en completar la vuelta. Lo que si me he atrevido es a rehacer las macros, que publicaré con tu permiso en mi tablón de LinkedIn.

Y es lo que hice en esta publicación: Roller Coaster | ExcelPedroWave | LinkedIn

Ahora voy a publicar un revisión de las macros originales de George Lungu, para intentar montarme en la "montaña rusa" en cualquier versión a partir de Excel 2010.

Vídeo de la montaña rusa en Excel

En este vídeo la he probado en Excel para Microsoft 365, completando la vuelta en unos 24 segundos con un retardo de 20 milisegundos.

¿Cómo mejorar la montaña rusa en Excel?

He intentado mejorar la "montaña rusa" con una mínima reingeniería en VBA para:

Guardar el archivo como .xlsm, compatible a partir de Excel 2007 y que ocupa menos tamaño, por ser guardado en formato XML comprimido en ZIP.
Proteger las hojas 'Roller Coaster' y 'Calculations' sin contraseña, para lo que únicamente ha hecho falta desbloquear algunas celdas.
Poner en la hoja 'Calculations' un 0 en AG45, un 1 en AG46 y un 2 en AG76 para que el reseteo sea a velocidad 0 y la vuelta comience a velocidad 1.
Guardar en la hoja 'Calculations' solamente las macros para los controles de número (Forms.SpinButton) alineados.
Crear un módulo 'modCoaster' con las macros de George modificadas ¡y comentadas!
Editar la macro 'Go_' para arrancar y pausar la vuelta, haciendo clic en el sol o estrella: Go 🌞
Modificar la macro para que el índice, Index de la celda C21, se calcule sin decimales...
Cambiar el nombre de la variable n por: Private bLoop As Boolean
Quitar las macros sobrantes hechas con el grabador de macros.
Añadir: Option Explicit en honor a Jordan Morris Goldmeier.

Lo que nunca he pretendido ha sido modificar la lógica de las fórmulas de George Lungu, que consiguen mover la "montaña rusa" en un gráfico de dispersión con líneas suavizadas, por lo que casi todos los cambios los he hecho en las macros.

Lo que he tratado de resolver es la gran diferencia de tiempos que tarda una vuelta en mis dos portátiles con la versión original, que se puede descargar desde aquí:

Animated Roller Coaster in Excel – Excel Unusual

Tarda de 57 a 62 segundos en mi viejo portátil, con Excel 2010 en Windows 7 y con una tarjeta gráfica ATI Radeon.
Tarda de 11 a 13 segundos en mi nuevo portátil, con Excel para Microsoft 365 en Windows 11 y con una tarjeta gráfica NVIDIA.

Lo que quiero es que la vuelta dure aproximadamente lo mismo en mis dos portátiles, para lo que he añadido un retardo, obteniendo estos tiempos:

Con un retardo de 20 milisegundos consigo unos 70 segundos por vuelta en mi viejo portátil.
Con un retardo de 100 milisegundos consigo unos 70 segundos por vuelta en mi nuevo portátil.

Tiempos inferiores no me satisfacen, por ser una velocidad demasiado elevada para disfrutar de la vuelta...

¡Cambios en las macros de la montaña rusa en Excel!

Estas son la macros, modificadas con el permiso de George Lungu, en el módulo modCoaster:

' ------------------------------------------------------
'   VBA Project:    Coaster7_short-may2022_PW1
'   Module:         modCoaster
'   Author:         George Lungu
'   Copyright:      © 2009-2022 by George Lungu
'   Web:            https://excelunusual.com/coaster/
'   Last edit:      2022-06-03 by Pedro Wave
'   Purpose:        Roller Coaster macros
' ------------------------------------------------------

Option Explicit

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds as Long) 'For 32 Bit Systems
#End If

Private bLoop As Boolean

Sub Go_()
'
' Go Roller Coaster
' Loop play/pause/stop function
' Delay to control the ride's speed
' Reporting the ride's time in seconds
'
    Dim ii As Integer
    Dim sgTimer As Single
    Dim sgDelay As Single
    
    ' Initialize variables
    SelectCell
    sgDelay = [myDelay] / 1000
    sgTimer = Timer
    If [myIndex] < 1 Then
        [myIndex] = 1
        [mySeconds] = ""
    Else
        sgTimer = sgTimer - [mySeconds]
    End If
    
    ' Roller Coaster loop?
    bLoop = Not bLoop
    ' Loop play?
    If bLoop Then
        ' Roller Coaster ride
        For ii = [myIndex] To 2100
            ' Index depends of the ride speed
            ' Notice the conversion to integers
            [myIndex] = [myIndex] + Int([mySpeed])
            ' Loop delay
            Delay sgDelay
            ' Loop pause?
            If bLoop = False Then GoTo EXIT1
            ' Loop stop?
            If [myIndex] > 1980 Then
                Reset_Change
                GoTo EXIT1
            End If
        Next ii
    End If
    
EXIT1:
    ' Ride time
    [mySeconds] = Timer - sgTimer
End Sub

Sub Delay(sgDelay As Single)
'
' Delay with the Timer function
'
    Dim myTimer As Single
    
    If sgDelay = 0 Then
        ' Yields execution to process other events
        DoEvents
    Else
        ' Delay greater than 0
        If [mySleep] = "Sleep" Then
            ' Sleep function in miliseconds
            Sleep sgDelay * 1000
            ' Yields execution to process other events
            DoEvents
        Else
            ' Add delay to the Timer function
            myTimer = Timer + sgDelay
            ' Loop delay
            Do
                ' Yields execution to process other events
                DoEvents
                ' Loop until the delay is exceeded
            Loop While Timer < myTimer
        End If
    End If
End Sub

Sub Reset_Change()
'
' Reset Roller Coaster
'
    bLoop = False
    [myIndex] = 0
    [mySeconds] = ""
    SelectCell
End Sub

Sub SelectCell()
'
' Select default cell and protect sheet
'
    If ActiveSheet.Name = "Calculations" Then
        ' Try to edit the Index cell
        Range("myIndex").Select
    Else
        ' Hidden cell
        Range("E2").Select
    End If
    ' Protect sheet
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

He incluido la función Timer y la función Sleep, sabiendo que esta última es una mala elección, pero la he incluido para comparar el efecto de las dos funciones.

Un desplegable en la celda A24 de la hoja 'Calculations' permite elegir entre: Delay (con la función Timer) y Sleep (con la función Sleep).

En la celda B24 se introduce el retardo en milisegundos, de uno en uno o de diez en diez, con el control de número ActiveX de la derecha.

El número total de segundos que se tarda en dar una vuelta se informa en la celda B26.

La posición de la "montaña rusa" se puede modificar con el índice, Index de la celda C21.

También he añadido una barra de desplazamiento para modificar fácilmente el índice, pudiendo cambiar de uno en uno o de diez en diez.

Incluso se puede mover en sentido inverso, gracias a esa barra de desplazamiento.

Otra característica nueva es la posibilidad de pausar la "montaña rusa" con el mismo botón con el que se arranca, ese icono con un sol. 🌞

Descarga la montaña rusa

Puedes descargar esta montaña rusa v1.0 desde estos enlaces:

Microsoft OneDrive: Coaster7_short-may2022_delay-PW1.xlsm

Sites Google Drive: Coaster7_short-may2022_delay-PW1.xlsm

Abre la plantilla con una versión de Excel de escritorio igual o superior a Excel 2007 y presiona el botón: Habilitar edición

Aparece una ADVERTENCIA DE SEGURIDAD: Las macros se han deshabilitado. Presiona el botón: Habilitar contenido

Esta plantilla contiene macros y no está protegida, por lo que se pueden estudiar y analizar las fórmulas y el código VBA, gracias a que su autor original la compartió así desde que la publicó hace más de 11 años.

¿Una nueva montaña rusa?

George Lungu me ha mandado este fin de semana un par de versiones nuevas de la "montaña rusa" para probarlas.

¡Y me ha vuelto a dejar impresionado!

¡Este hombre no tiene límites en Excel!

George acaba de subir un vídeo con los cambios en la montaña rusa que ha hecho últimamente.

Traducción de la descripción del vídeo:

Por demanda popular, vuelvo a Excel después de un largo paréntesis. Y esta vez lo haré a lo grande.

Agregué algunas características al modelo de montaña rusa de la siguiente manera:

1) Registro de rendimiento

2) Todo tipo de colores y selección de esquemas de color.

3) control de velocidad

4) Ajuste de la longitud del posavasos

5) Ajuste del tamaño del plano de tierra (malla)

Todo este modelo se reconstruirá desde cero con mucha mejor velocidad (en el nuevo Excel) y una variedad de pistas. También mentiría para hacerlo ajustable, de modo que los usuarios puedan crear sus propias pistas personalizadas.

¡¡¡Gracias por su apoyo!!!

Se puede descargar desde aquí:

A 3D Animated Excel Roller Coaster – video preview – Excel Unusual

¡¡¡ Disfruta del viaje !!!

1 Response to "Montaña Rusa Excel Roller Coaster"

Excel Pedro Wave Says....

13 junio, 2022 09:29

George acaba de subir un vídeo mostrando los cambios que ha hecho últimamente a su montaña rusa: Excel Roller Coaster Update #1

Indícame las erratas que encuentres y qué es lo que te gustaría ver en los próximos artículos.

#ExcelPedroWave

Traducir el blog