Juego de Ahorcado en Excel usando VBA
Dim PalabraAdivinar As String
Dim LetrasAdivinadas As String
Dim IntentosRestantes As Integer
Dim ConceptoFuncion As String
Sub IniciarJuego()
' Lista de funciones de Excel en español
Dim FuncionesExcel As Variant
FuncionesExcel = Array("BUSCARV", "BUSCARH", "SUMA", "SI", "CONTAR.SI", "SUMAR.SI", "PROMEDIO", "MIN", "MAX", "CONTAR", "HOY", "AHORA", "REDONDEAR", "CONCATENAR", "IZQUIERDA", "DERECHA", "EXTRAE", "ESNUMERO", "NO.ES", "INDICE")
' Seleccionar una palabra al azar de la lista
Randomize
Dim Indice As Integer
Indice = Int((UBound(FuncionesExcel) - LBound(FuncionesExcel) + 1) * Rnd + LBound(FuncionesExcel))
PalabraAdivinar = UCase(FuncionesExcel(Indice))
' Asignar un concepto a la función seleccionada
Select Case PalabraAdivinar
Case "BUSCARV": ConceptoFuncion = "Busca un valor en una columna."
Case "BUSCARH": ConceptoFuncion = "Busca un valor en una fila."
Case "SUMA": ConceptoFuncion = "Suma un rango de celdas."
Case "SI": ConceptoFuncion = "Realiza una comparación lógica."
Case "CONTAR.SI": ConceptoFuncion = "Cuenta celdas que cumplen un criterio."
Case "SUMAR.SI": ConceptoFuncion = "Suma celdas que cumplen un criterio."
Case "PROMEDIO": ConceptoFuncion = "Calcula el promedio de un rango."
Case "MIN": ConceptoFuncion = "Devuelve el valor mínimo."
Case "MAX": ConceptoFuncion = "Devuelve el valor máximo."
Case "CONTAR": ConceptoFuncion = "Cuenta celdas con números."
Case "HOY": ConceptoFuncion = "Devuelve la fecha actual."
Case "AHORA": ConceptoFuncion = "Devuelve fecha y hora actuales."
Case "REDONDEAR": ConceptoFuncion = "Redondea un número."
Case "CONCATENAR": ConceptoFuncion = "Une textos de varias celdas."
Case "IZQUIERDA": ConceptoFuncion = "Devuelve caracteres desde la izquierda."
Case "DERECHA": ConceptoFuncion = "Devuelve caracteres desde la derecha."
Case "EXTRAE": ConceptoFuncion = "Extrae texto de una cadena."
Case "ESNUMERO": ConceptoFuncion = "Verifica si el valor es número."
Case "NO.ES": ConceptoFuncion = "Verifica si el valor no es un error."
Case "INDICE": ConceptoFuncion = "Devuelve el valor de una referencia."
End Select
LetrasAdivinadas = ""
IntentosRestantes = 6 ' Se permite un máximo de 6 intentos fallidos
' Limpiar celdas usadas para mostrar el progreso
Range("A2:Z2").ClearContents
Range("A4").Value = "Intentos restantes: " & IntentosRestantes
' Mostrar la palabra oculta con guiones bajos
ActualizarPantalla
End Sub
Sub IntentarLetra()
Dim Letra As String
Letra = UCase(InputBox("Introduce una letra:", "Juego del Ahorcado"))
' Validar que solo se haya ingresado una letra
If Len(Letra) <> 1 Or Not (Letra Like "[A-Z]") Then
MsgBox "Por favor, introduce solo una letra.", vbExclamation
Exit Sub
End If
' Comprobar si la letra ya fue adivinada
If InStr(LetrasAdivinadas, Letra) > 0 Then
MsgBox "Ya has intentado esta letra.", vbExclamation
Exit Sub
End If
' Añadir la letra a la lista de letras adivinadas
LetrasAdivinadas = LetrasAdivinadas & Letra
' Comprobar si la letra está en la palabra
If InStr(PalabraAdivinar, Letra) > 0 Then
MsgBox "¡Correcto! La letra está en la palabra.", vbInformation
Else
MsgBox "Incorrecto. La letra no está en la palabra.", vbExclamation
IntentosRestantes = IntentosRestantes - 1
End If
' Actualizar pantalla
ActualizarPantalla
' Comprobar si el juego ha terminado
If IntentosRestantes = 0 Then
MsgBox "Has perdido. La palabra era: " & PalabraAdivinar, vbCritical
Exit Sub
ElseIf PalabraCompleta() Then
MsgBox "¡Felicidades! Has adivinado la palabra: " & PalabraAdivinar & vbCrLf & "Concepto: " & ConceptoFuncion, vbInformation
Exit Sub
End If
End Sub
Sub ActualizarPantalla()
Dim i As Integer, MostrarPalabra As String
MostrarPalabra = ""
' Construir la palabra con las letras adivinadas y guiones bajos
For i = 1 To Len(PalabraAdivinar)
If InStr(LetrasAdivinadas, Mid(PalabraAdivinar, i, 1)) > 0 Then
MostrarPalabra = MostrarPalabra & Mid(PalabraAdivinar, i, 1) & " "
Else
MostrarPalabra = MostrarPalabra & "_ "
End If
Next i
' Mostrar la palabra en la celda A2
Range("A2").Value = MostrarPalabra
' Actualizar el número de intentos restantes
Range("A4").Value = "Intentos restantes: " & IntentosRestantes
End Sub
Function PalabraCompleta() As Boolean
Dim i As Integer
' Comprobar si todas las letras de la palabra han sido adivinadas
For i = 1 To Len(PalabraAdivinar)
If InStr(LetrasAdivinadas, Mid(PalabraAdivinar, i, 1)) = 0 Then
PalabraCompleta = False
Exit Function
End If
Next i
PalabraCompleta = True
End Function
.webp)
