Sencilla aplicación en Excel

Hoy os presento una sencilla aplicación para excel, que no es otra cosa que un test de inteligencia. Las imágenes las he tomado prestadas de la web www.mensa.es. El resto es de cosecha propia, tanto la escala con las valoraciones, como los comentarios emitidos sobre los resultados del propio test.

En esta pequeña aplicación, podemos ver los siguientes elementos:

• Cuadros de diálogo (Msgbox).


• Protección y desprotección de la hoja mediante código (sin password, es decir, protegiendo la hoja con un simpLe intro).


• Impedir la cancelación del macro, como por ejemplo pulsando la tecla ESC.


• Uso de condicionales en macros if. Al ser una condición incluida en una sola línea, podemos omitir el enf if.


• Uso de la validación de datos (las celdas con las respuestas a seleccionar solo aceptan los valores: A, B, C, D, E, F.


• Uso de variables (la variable contar. Quizás esto requiera una pequeña explicación, porque hasta ahora no lo he hecho en el caso de los otros macros de este blog.

En el test, veréis una variable (¿recordáis las variables X, tan famosas en matemáticas?) que he llamado contar. Si os fijáis, en el código siempre aparece de la siguiente forma:

contar = contar + 1

Y eso significa que la parte derecha del igual, la tiene que asociar a lo que hay en la parte izquierda del igual. Explicado más sencillamente, quiere decir que el resultado de contar + 1 debe asociarlo a contar. La primera vez que llamemos a esa ecuación, la parte derecha de la misma, valdrá 1, ya que contar (me refiero al contar que hay sumando al 1), en el momento inicial no vale nada, es decir, no tiene ningún dato, por lo que vale cero.

Por tanto, la primera vez que llamemos a la variable contar -siempre y cuando hayamos respondido correctamente la respuesta del test-, ésta valdrá:

contar = 0 + 1, es decir, si las matemáticas no fallan, eso vale 1. Por tanto, contar = 1

La segunda vez que llamemos a la variable contar (podéis ver el código del macro), haremos lo mismo:

contar = contar + 1

Pero en este caso, como contar vale 1, puesto que arrastramos su valor de la línea anterior (mientras no finalice el macro, la variable mantiene su valor en la memoria del pc), entonces la ecuación sería la siguiente:

contar = 1 + 1, es decir, contar = 2

Así seguiríamos haciendo hasta llegar a la pregunta 17 del test. En el caso de que contestemos correctamente a todas las preguntas, la variable contar valdría 17, porque tendríamos una ecuación como esta, que vendríamos arrastrando:

contar = 16 + 1, es decir, contar = 17

Aquí os dejo un pantallazo, así como el código de los tres macros que veréis en el módulo VBA:

Sub Comprobar() On Error GoTo Fin 'Desprotegemos la hoja ActiveSheet.Unprotect 'Desactivamos las teclas de cancelación de macros Application.EnableCancelKey = xlDisabled 'No ocultamos los pasos que efectúa el procedimiento porque 'no queremos que se refresquen las imágenes insertadas... 'Mostramos un mensaje si no se han contestado las 17 preguntas If Range("E12") = "" Or Range("E15") = "" Or Range("E18") = "" Or _ Range("E21") = "" Or Range("E24") = "" Or Range("E27") = "" Or _ Range("E30") = "" Or Range("E33") = "" Or Range("E36") = "" Or _ Range("E39") = "" Or Range("E42") = "" Or Range("E45") = "" Or _ Range("E48") = "" Or Range("E51") = "" Or Range("E54") = "" Or _ Range("E57") = "" Or Range("E60") = "" Then MsgBox (Chr(13) + " No has contestado a todas las preguntas, " + _ Chr(13) + " por favor revisa el cuestionario. " + _ Chr(13) + Chr(13)), vbOKOnly, " DATOS INCOMPLETOS" End End If 'Definimos las variables, y comprobamos el número de aciertos If UCase(Range("E12")) = "C" Then Contar = Contar + 1 If UCase(Range("E15")) = "E" Then Contar = Contar + 1 If UCase(Range("E18")) = "C" Then Contar = Contar + 1 If UCase(Range("E21")) = "F" Then Contar = Contar + 1 If UCase(Range("E24")) = "B" Then Contar = Contar + 1 If UCase(Range("E27")) = "E" Then Contar = Contar + 1 If UCase(Range("E30")) = "D" Then Contar = Contar + 1 If UCase(Range("E33")) = "C" Then Contar = Contar + 1 If UCase(Range("E36")) = "C" Then Contar = Contar + 1 If UCase(Range("E39")) = "E" Then Contar = Contar + 1 If UCase(Range("E42")) = "D" Then Contar = Contar + 1 If UCase(Range("E45")) = "E" Then Contar = Contar + 1 If UCase(Range("E48")) = "A" Then Contar = Contar + 1 If UCase(Range("E51")) = "A" Then Contar = Contar + 1 If UCase(Range("E54")) = "F" Then Contar = Contar + 1 If UCase(Range("E57")) = "D" Then Contar = Contar + 1 If UCase(Range("E60")) = "B" Then Contar = Contar + 1 'Mostramos un mensaje con el número de aciertos, 'y con el nivel de inteligencia If Contar <= 6 Then MsgBox (Chr(13) + " Has contestado correctamente a " & Contar & _ " de las 17 preguntas. " + Chr(13) + Chr(13) + " Por tanto, podemos " + _ "concluir -a falta de otras pruebas más científicas-, que tienes un " + _ Chr(13) + " nivel de inteligencia muy por debajo de la media de la población. " + _ "Probablemente, en " + Chr(13) + " tu vida diara, en tu ámbito personal, " + _ "o profesional, te encontrarás con problemas, a " + Chr(13) + " los que no " + _ "podrás encontrarles una solución. " + Chr(13) + Chr(13)), vbOKOnly, " RESULTADOS" Contar = Empty End If If Contar = 7 Or Contar = 8 Then MsgBox (Chr(13) + " Has contestado correctamente a " & Contar & " de las 17 " + _ "preguntas. " + Chr(13) + Chr(13) + " Por tanto, podemos concluir -a falta de " + _ "otras pruebas más científicas-, que tienes un " + Chr(13) + " nivel de " + _ "inteligencia por debajo de la media de la población. Probablemente, en tu " + _ Chr(13) + " vida diara, en tu ámbito personal, o profesional, te encontrarás " + _ "con problemas, a los " + Chr(13) + " que te será muy difícil encontrarles " + _ "una solución. " + Chr(13) + Chr(13)), vbOKOnly, " RESULTADOS" Contar = Empty End If If Contar = 9 Or Contar = 10 Then MsgBox (Chr(13) + " Has contestado correctamente a " & Contar & " de las 17 " + _ "preguntas. " + Chr(13) + Chr(13) + " Por tanto, podemos concluir -a falta de " + _ "otras pruebas más científicas-, que tienes un " + Chr(13) + " nivel de " + _ "inteligencia como la media de la población, aunque en la parte baja de la " + _ "banda. " + Chr(13) + " Es decir, tú eres una persona con un nivel de " + _ "inteligencia JUSTITO, aunque repito, " + Chr(13) + " dentro de la media " + _ "de la población. " + Chr(13) + Chr(13)), vbOKOnly, " RESULTADOS" Contar = Empty End If If Contar = 11 Or Contar = 12 Then MsgBox (Chr(13) + " Has contestado correctamente a " & Contar & " de las 17 " + _ "preguntas. " + Chr(13) + Chr(13) + " Por tanto, podemos concluir -a falta de " + _ "otras pruebas más científicas-, que tienes un " + Chr(13) + " nivel de " + _ "inteligencia como la media de la población. Es decir, tú eres una persona " + _ Chr(13) + " con un nivel de inteligencia NORMAL. " + _ Chr(13) + Chr(13)), vbOKOnly, " RESULTADOS" Contar = Empty End If If Contar = 13 Or Contar = 14 Then MsgBox (Chr(13) + " Has contestado correctamente a " & Contar & " de las 17 " + _ "preguntas. " + Chr(13) + Chr(13) + " Por tanto, podemos concluir -a falta de " + _ "otras pruebas más científicas-, que tienes un " + Chr(13) + " nivel de " + _ "inteligencia como la media de la población, aunque en la parte alta de la banda. " + _ Chr(13) + " Es decir, tú eres una persona que se puede calificar de INTELIGENTE. " + _ Chr(13) + Chr(13)), vbOKOnly, " RESULTADOS" Contar = Empty End If If Contar = 15 Or Contar = 16 Then MsgBox (Chr(13) + " Has contestado correctamente a " & Contar & " de las 17 " + _ "preguntas. " + Chr(13) + Chr(13) + " Por tanto, podemos concluir -a falta de " + _ "otras pruebas más científicas-, que tienes un " + Chr(13) + " nivel de " + _ "inteligencia superior a la media. Es decir, tú eres una persona que se puede " + _ Chr(13) + " calificar de MUY INTELIGENTE, aunque sin llegar a ser un " + _ "SUPERDOTADO. " + Chr(13) + Chr(13)), vbOKOnly, " RESULTADOS" Contar = Empty End If If Contar = 17 Then MsgBox (Chr(13) + " Eres un genio. Has contestado correctamente a las 17 " + _ "preguntas. " + Chr(13) + Chr(13) + " Por tanto, podemos concluir -a falta de " + _ "otras pruebas más científicas-, que tienes un " + Chr(13) + " nivel de " + _ "inteligencia muy superior a la media. Es decir, tú eres lo que normalmente se " + _ Chr(13) + " denomina, un SUPERDOTADO. " + Chr(13) + Chr(13) + " No sé si eso " + _ "es bueno o malo, pero tu capacidad para resolver los problemas que se " + _ Chr(13) + " te pueden plantear en la vida diaria, en tu ámbito personal, o en " + _ "el profesional, muy " + Chr(13) + " pocas personas la tienen. " + _ Chr(13) + Chr(13)), vbOKOnly, " RESULTADOS" Contar = Empty End If 'Protegemos la hoja nuevamente ActiveSheet.Protect Fin: End Sub

Sub Borrar() On Error GoTo Fin 'No hace falta que desprotejamos ni que protejamos al final, 'porque vamos a borrar celdas que no están protegidas. 'Desactivamos las teclas de cancelación de macros Application.EnableCancelKey = xlDisabled 'No ocultamos los pasos que efectúa el procedimiento porque 'no queremos que se refresquen las imágenes insertadas... 'Mostramos un mensaje si no se han contestado todas las preguntas If Range("E12") = "" And Range("E15") = "" And Range("E18") = "" And Range("E21") = "" _ And Range("E24") = "" And Range("E27") = "" And Range("E30") = "" And Range("E33") = "" _ And Range("E36") = "" And Range("E39") = "" And Range("E42") = "" And Range("E45") = "" _ And Range("E48") = "" And Range("E51") = "" And Range("E54") = "" And Range("E57") = "" _ And Range("E60") = "" Then MsgBox (Chr(13) + " No hay ninguna respuesta que borrar. " + _ Chr(13) + Chr(13)), vbOKOnly, " SIN DATOS" End If Range("E12, E15, E18, E21, E24, E27, E30, E33, E36, E39, E42, E45, E48, E51, E54, E57, E60").ClearContents Fin: End Sub

Sub auto_close() 'Si alguna de las celdas contiene datos, las borramos If Range("E12") <> "" Or Range("E15") <> "" Or Range("E18") <> "" Or Range("E21") <> "" _ Or Range("E24") <> "" Or Range("E27") <> "" Or Range("E30") <> "" Or Range("E33") <> "" _ Or Range("E36") <> "" Or Range("E39") <> "" Or Range("E42") <> "" Or Range("E45") <> "" _ Or Range("E48") <> "" Or Range("E51") <> "" Or Range("E54") <> "" Or Range("E57") <> "" _ Or Range("E60") <> "" Then 'Omitimos los mensajes de aviso Application.DisplayAlerts = False 'llamamos al macro Borrar Borrar 'grabamos el fichero con las respuestas borradas ThisWorkbook.Save End If End Sub

Desde aquí podéis descargar el fichero de excel, con todo el código que os presento en este artículo, y por supuesto, con el test de inteligencia para que evaluéis vuestras posibilidades, que sin duda son mucho mayores que las mías :-)

Como veréis, el código VBA está sin proteger, para que le echéis un vistazo al código. Tened en cuenta que si lo distribuís entre amiguetes o compañeros del trabajo, sería conveniente que protegierais para impedir su visualización, desde nuestra ventana de VBA, seleccionando en el menú Herramientas, la opción Propiedades de VBAProject…, y en la pestaña Protección, marcando con una muesca Bloquear proyecto para visualización, poniendo a continuación una contraseña, y confirmándola nuevamente.