Buscar alumno por nombre y mostrar sus calificaciones
Private Sub cmdBuscarAlumno_Click()
Dim alumnoBuscado As String
Dim ultimaFila As Long
Dim i As Long
Dim encontrado As Boolean
alumnoBuscado = InputBox("Ingrese el nombre del alumno a buscar:")
ultimaFila = Cells([Link], 1).End(xlUp).Row
encontrado = False
For i = 2 To ultimaFila
If Cells(i, 1).Value = alumnoBuscado Then
MsgBox "Alumno: " & Cells(i, 1).Value & vbCrLf & _
"Calificación: " & Cells(i, 2).Value, vbInformation, "Resultado"
encontrado = True
Exit For
End If
Next i
If Not encontrado Then
MsgBox "El alumno '" & alumnoBuscado & "' no se encontró en la lista.",
vbExclamation, "Aviso"
End If
End Sub
Buscar producto por código y mostrar stock
Private Sub cmdBuscarProducto_Click()
Dim codigoBuscado As String
Dim ultimaFila As Long
Dim i As Long
Dim encontrado As Boolean
codigoBuscado = InputBox("Ingrese el código del producto:")
ultimaFila = Cells([Link], 1).End(xlUp).Row
encontrado = False
For i = 2 To ultimaFila
If Cells(i, 1).Value = codigoBuscado Then
MsgBox "Producto: " & Cells(i, 2).Value & vbCrLf & _
"Stock disponible: " & Cells(i, 3).Value, vbInformation,
"Resultado"
encontrado = True
Exit For
End If
Next i
If Not encontrado Then
MsgBox "El código '" & codigoBuscado & "' no se encontró.", vbExclamation,
"Aviso"
End If
End Sub
Buscar libro y mostrar autor y editorial
Private Sub cmdBuscarLibro_Click()
Dim libroBuscado As String
Dim ultimaFila As Long
Dim i As Long
Dim encontrado As Boolean
libroBuscado = InputBox("Ingrese el título del libro:")
ultimaFila = Cells([Link], 1).End(xlUp).Row
encontrado = False
For i = 2 To ultimaFila
If Cells(i, 1).Value = libroBuscado Then
MsgBox "Libro: " & Cells(i, 1).Value & vbCrLf & _
"Autor: " & Cells(i, 2).Value & vbCrLf & _
"Editorial: " & Cells(i, 3).Value, vbInformation, "Resultado"
encontrado = True
Exit For
End If
Next i
If Not encontrado Then
MsgBox "El libro '" & libroBuscado & "' no se encontró.", vbExclamation,
"Aviso"
End If
End Sub
Buscar empleado por ID y mostrar salario
Private Sub cmdBuscarEmpleado_Click()
Dim idBuscado As String
Dim ultimaFila As Long
Dim i As Long
Dim encontrado As Boolean
idBuscado = InputBox("Ingrese el ID del empleado:")
ultimaFila = Cells([Link], 1).End(xlUp).Row
encontrado = False
For i = 2 To ultimaFila
If Cells(i, 1).Value = idBuscado Then
MsgBox "Empleado: " & Cells(i, 2).Value & vbCrLf & _
"Salario: $" & Cells(i, 3).Value, vbInformation, "Resultado"
encontrado = True
Exit For
End If
Next i
If Not encontrado Then
MsgBox "El ID '" & idBuscado & "' no se encontró.", vbExclamation, "Aviso"
End If
End Sub
Buscar fecha y mostrar evento asociado
Private Sub cmdBuscarEvento_Click()
Dim fechaBuscada As String
Dim ultimaFila As Long
Dim i As Long
Dim encontrado As Boolean
fechaBuscada = InputBox("Ingrese la fecha a buscar (dd/mm/aaaa):")
ultimaFila = Cells([Link], 1).End(xlUp).Row
encontrado = False
For i = 2 To ultimaFila
If Cells(i, 1).Value = fechaBuscada Then
MsgBox "Fecha: " & Cells(i, 1).Value & vbCrLf & _
"Evento: " & Cells(i, 2).Value, vbInformation, "Resultado"
encontrado = True
Exit For
End If
Next i
If Not encontrado Then
MsgBox "La fecha '" & fechaBuscada & "' no se encontró.", vbExclamation,
"Aviso"
End If
End Sub
Calcular el promedio de 10 estudiantes
Private Sub cmdPromedioAlumnos_Click()
Dim ultimaFila As Long
Dim suma As Double
Dim i As Long
ultimaFila = Cells([Link], 2).End(xlUp).Row ' Columna B = calificaciones
suma = 0
For i = 2 To ultimaFila
suma = suma + Cells(i, 2).Value
Next i
MsgBox "El promedio de los alumnos es: " & Format(suma / (ultimaFila - 1),
"0.00"), vbInformation, "Resultado"
End Sub
Sumar ventas de un rango dinámico
Private Sub cmdSumarVentas_Click()
Dim ultimaFila As Long
Dim totalVentas As Double
Dim i As Long
ultimaFila = Cells([Link], 3).End(xlUp).Row ' Columna C = ventas
totalVentas = 0
For i = 2 To ultimaFila
totalVentas = totalVentas + Cells(i, 3).Value
Next i
MsgBox "El total de ventas es: $" & Format(totalVentas, "0.00"), vbInformation,
"Resultado"
End Sub
Calcular IVA de un subtotal
Private Sub cmdCalcularIVA_Click()
Dim subtotal As Double
Dim iva As Double
Dim total As Double
subtotal = InputBox("Ingrese el subtotal:")
iva = subtotal * 0.16
total = subtotal + iva
MsgBox "Subtotal: $" & subtotal & vbCrLf & _
"IVA (16%): $" & iva & vbCrLf & _
"Total: $" & total, vbInformation, "Cálculo de IVA"
End Sub
Generar el total de un presupuesto con 20 conceptos
Private Sub cmdPresupuesto_Click()
Dim ultimaFila As Long
Dim total As Double
Dim i As Long
ultimaFila = Cells([Link], 4).End(xlUp).Row ' Columna D = conceptos
total = 0
For i = 2 To ultimaFila
total = total + Cells(i, 4).Value
Next i
MsgBox "El total del presupuesto es: $" & Format(total, "0.00"), vbInformation,
"Resultado"
End Sub
Calcular descuentos según porcentaje ingresado
Private Sub cmdCalcularDescuento_Click()
Dim precioOriginal As Double
Dim porcentaje As Double
Dim descuento As Double
Dim precioFinal As Double
precioOriginal = InputBox("Ingrese el precio original:")
porcentaje = InputBox("Ingrese el porcentaje de descuento:")
descuento = precioOriginal * (porcentaje / 100)
precioFinal = precioOriginal - descuento
MsgBox "Precio original: $" & precioOriginal & vbCrLf & _
"Descuento: $" & descuento & vbCrLf & _
"Precio final: $" & precioFinal, vbInformation, "Cálculo de descuento"
End Sub
Contar cuántos alumnos aprobaron
Private Sub cmdContarAprobados_Click()
Dim ultimaFila As Long
Dim i As Long
Dim aprobados As Long
ultimaFila = Cells([Link], 2).End(xlUp).Row ' Columna B = calificaciones
aprobados = 0
For i = 2 To ultimaFila
If Cells(i, 2).Value >= 6 Then ' Nota mínima aprobatoria
aprobados = aprobados + 1
End If
Next i
MsgBox "Número de alumnos aprobados: " & aprobados, vbInformation, "Reporte"
End Sub
Contar cuántos productos están agotados
Private Sub cmdContarAgotados_Click()
Dim ultimaFila As Long
Dim i As Long
Dim agotados As Long
ultimaFila = Cells([Link], 3).End(xlUp).Row ' Columna C = stock
agotados = 0
For i = 2 To ultimaFila
If Cells(i, 3).Value = 0 Then
agotados = agotados + 1
End If
Next i
MsgBox "Productos agotados: " & agotados, vbInformation, "Inventario"
End Sub
Calcular la nota más alta y más baja
Private Sub cmdNotasExtremos_Click()
Dim ultimaFila As Long
Dim i As Long
Dim maxNota As Double
Dim minNota As Double
ultimaFila = Cells([Link], 2).End(xlUp).Row
maxNota = Cells(2, 2).Value
minNota = Cells(2, 2).Value
For i = 3 To ultimaFila
If Cells(i, 2).Value > maxNota Then maxNota = Cells(i, 2).Value
If Cells(i, 2).Value < minNota Then minNota = Cells(i, 2).Value
Next i
MsgBox "Nota más alta: " & maxNota & vbCrLf & _
"Nota más baja: " & minNota, vbInformation, "Reporte de notas"
End Sub
Generar un reporte de asistencia
Private Sub cmdReporteAsistencia_Click()
Dim ultimaFila As Long
Dim i As Long
Dim presentes As Long
Dim ausentes As Long
ultimaFila = Cells([Link], 3).End(xlUp).Row ' Columna C = asistencia (P/A)
presentes = 0
ausentes = 0
For i = 2 To ultimaFila
If UCase(Cells(i, 3).Value) = "P" Then
presentes = presentes + 1
ElseIf UCase(Cells(i, 3).Value) = "A" Then
ausentes = ausentes + 1
End If
Next i
MsgBox "Presentes: " & presentes & vbCrLf & _
"Ausentes: " & ausentes, vbInformation, "Reporte de asistencia"
End Sub
Mostrar el promedio general de la clase
Private Sub cmdPromedioGeneral_Click()
Dim ultimaFila As Long
Dim i As Long
Dim suma As Double
ultimaFila = Cells([Link], 2).End(xlUp).Row
suma = 0
For i = 2 To ultimaFila
suma = suma + Cells(i, 2).Value
Next i
MsgBox "Promedio general de la clase: " & Format(suma / (ultimaFila - 1),
"0.00"), vbInformation, "Resultado"
End Sub
Ordenar productos por precio
Private Sub cmdOrdenarPorPrecio_Click()
Dim ultimaFila As Long
ultimaFila = Cells([Link], 2).End(xlUp).Row ' Columna B = precios
' Ordenar de menor a mayor
Range("A2:B" & ultimaFila).Sort Key1:=Range("B2"), Order1:=xlAscending,
Header:=xlNo
MsgBox "Los productos se han ordenado por precio (menor a mayor).",
vbInformation, "Ordenación"
End Sub
Ordenar alumnos por calificación
Private Sub cmdOrdenarPorNota_Click()
Dim ultimaFila As Long
ultimaFila = Cells([Link], 2).End(xlUp).Row ' Columna B = calificaciones
' Ordenar de mayor a menor
Range("A2:B" & ultimaFila).Sort Key1:=Range("B2"), Order1:=xlDescending,
Header:=xlNo
MsgBox "Los alumnos se han ordenado por calificación (mayor a menor).",
vbInformation, "Ordenación"
End Sub
Filtrar artículos con precio mayor a 100
Private Sub cmdFiltrarPrecio_Click()
Dim ultimaFila As Long
ultimaFila = Cells([Link], 2).End(xlUp).Row
Range("A1:B" & ultimaFila).AutoFilter Field:=2, Criteria1:=">100"
MsgBox "Se han filtrado los artículos con precio mayor a 100.", vbInformation,
"Filtro"
End Sub
Filtrar empleados con más de 5 años de antigüedad
Private Sub cmdFiltrarAntiguedad_Click()
Dim ultimaFila As Long
ultimaFila = Cells([Link], 3).End(xlUp).Row ' Columna C = antigüedad
Range("A1:C" & ultimaFila).AutoFilter Field:=3, Criteria1:=">5"
MsgBox "Se han filtrado los empleados con más de 5 años de antigüedad.",
vbInformation, "Filtro"
End Sub
Mostrar solo fechas del mes actual
Private Sub cmdFiltrarMesActual_Click()
Dim ultimaFila As Long
Dim mesActual As Integer
ultimaFila = Cells([Link], 1).End(xlUp).Row ' Columna A = fechas
mesActual = Month(Date)
Range("A1:B" & ultimaFila).AutoFilter Field:=1, Criteria1:=">=" &
DateSerial(Year(Date), mesActual, 1), _
Operator:=xlAnd, Criteria2:="<=" &
DateSerial(Year(Date), mesActual + 1, 0)
MsgBox "Se muestran solo las fechas correspondientes al mes actual.",
vbInformation, "Filtro"
End Sub
Generar un número aleatorio como “pregunta sorpresa”
Private Sub cmdPreguntaSorpresa_Click()
Dim numero As Integer
numero = Int((10 - 1 + 1) * Rnd + 1) ' Número aleatorio entre 1 y 10
MsgBox "Pregunta sorpresa número: " & numero, vbInformation, "Dinámica"
End Sub
Crear un sorteo de alumnos para responder
Private Sub cmdSorteoAlumno_Click()
Dim ultimaFila As Long
Dim indice As Long
ultimaFila = Cells([Link], 1).End(xlUp).Row ' Columna A = nombres
Randomize
indice = Int((ultimaFila - 1) * Rnd + 2) ' Selección aleatoria
MsgBox "El alumno seleccionado es: " & Cells(indice, 1).Value, vbInformation,
"Sorteo"
End Sub
Simular un dado virtual
Private Sub cmdDadoVirtual_Click()
Dim dado As Integer
Randomize
dado = Int((6 * Rnd) + 1) ' Número entre 1 y 6
MsgBox "El dado muestra: " & dado, vbInformation, "Juego"
End Sub
Crear un juego de preguntas con InputBox y MsgBox
Private Sub cmdJuegoPreguntas_Click()
Dim respuesta As String
respuesta = InputBox("¿Cuál es la capital de México?")
If UCase(respuesta) = "CIUDAD DE MÉXICO" Then
MsgBox "¡Correcto!", vbInformation, "Juego"
Else
MsgBox "Incorrecto. La respuesta es Ciudad de México.", vbExclamation,
"Juego"
End If
End Sub
Mostrar un reto aleatorio de Excel
Private Sub cmdRetoAleatorio_Click()
Dim retos(1 To 5) As String
Dim indice As Integer
retos(1) = "Usa la función SUMA en un rango."
retos(2) = "Aplica formato condicional a una celda."
retos(3) = "Inserta un gráfico de barras."
retos(4) = "Crea una tabla dinámica."
retos(5) = "Escribe una fórmula con PROMEDIO."
Randomize
indice = Int((5 * Rnd) + 1)
MsgBox "Tu reto es: " & retos(indice), vbInformation, "Reto de Excel"
End Sub
Insertar automáticamente la fecha y hora en una celda
Private Sub cmdInsertarFechaHora_Click()
Dim celda As Range
Set celda = ActiveCell
[Link] = Now
MsgBox "Se insertó la fecha y hora actual en la celda seleccionada.", vbInformation,
"Automatización"
End Sub
Escribir el nombre del usuario en la hoja
Private Sub cmdInsertarUsuario_Click()
Dim celda As Range
Set celda = ActiveCell
[Link] = [Link]
MsgBox "Se insertó el nombre del usuario en la celda seleccionada.", vbInformation,
"Automatización"
End Sub
Generar un encabezado con título y fecha
Private Sub cmdEncabezado_Click()
Range("A1").Value = "Reporte de Actividades"
Range("B1").Value = "Fecha: " & Date
MsgBox "Se generó un encabezado con título y fecha en la primera fila.", vbInformation,
"Encabezado"
End Sub
Crear un pie de página automático
Private Sub cmdPiePagina_Click()
With [Link]
.CenterFooter = "Generado el " & Date & " por " & [Link]
End With
MsgBox "Se creó un pie de página automático con fecha y usuario.", vbInformation, "Pie
de página"
End Sub
Insertar un comentario en una celda seleccionada
Private Sub cmdComentarioCelda_Click()
Dim celda As Range
Dim texto As String
Set celda = ActiveCell
texto = InputBox("Ingrese el comentario para esta celda:")
If texto <> "" Then
[Link] texto
MsgBox "Se agregó un comentario a la celda seleccionada.", vbInformation,
"Comentario"
Else
MsgBox "No se ingresó ningún comentario.", vbExclamation, "Aviso"
End If
End Sub
Crear un gráfico de barras con calificaciones
Private Sub cmdGraficoBarras_Click()
Dim ultimaFila As Long
ultimaFila = Cells([Link], 1).End(xlUp).Row ' Columna A = nombres, Columna B =
calificaciones
[Link]
[Link] = xlColumnClustered
[Link] Source:=Range("A1:B" & ultimaFila)
[Link] Where:=xlLocationAsObject, Name:=[Link]
MsgBox "Se creó un gráfico de barras con las calificaciones.", vbInformation, "Gráfico"
End Sub
Generar un gráfico circular con porcentajes de ventas
Private Sub cmdGraficoCircular_Click()
Dim ultimaFila As Long
ultimaFila = Cells([Link], 1).End(xlUp).Row ' Columna A = productos, Columna B =
ventas
[Link]
[Link] = xlPie
[Link] Source:=Range("A1:B" & ultimaFila)
[Link] Where:=xlLocationAsObject, Name:=[Link]
MsgBox "Se creó un gráfico circular con las ventas.", vbInformation, "Gráfico"
End Sub
Mostrar un histograma de notas
Private Sub cmdHistogramaNotas_Click()
Dim ultimaFila As Long
ultimaFila = Cells([Link], 2).End(xlUp).Row ' Columna B = calificaciones
[Link]
[Link] = xlColumnClustered
[Link] Source:=Range("B1:B" & ultimaFila)
[Link] Where:=xlLocationAsObject, Name:=[Link]
MsgBox "Se creó un histograma de notas.", vbInformation, "Gráfico"
End Sub
Crear un gráfico dinámico de asistencia
Private Sub cmdGraficoAsistencia_Click()
Dim ultimaFila As Long
ultimaFila = Cells([Link], 1).End(xlUp).Row ' Columna A = nombres, Columna B =
asistencia
[Link]
[Link] = xlBarClustered
[Link] Source:=Range("A1:B" & ultimaFila)
[Link] Where:=xlLocationAsObject, Name:=[Link]
MsgBox "Se creó un gráfico de barras con la asistencia.", vbInformation, "Gráfico"
End Sub
Insertar un gráfico de líneas con evolución de precios
Private Sub cmdGraficoLineas_Click()
Dim ultimaFila As Long
ultimaFila = Cells([Link], 1).End(xlUp).Row ' Columna A = fechas, Columna B =
precios
[Link]
[Link] = xlLine
[Link] Source:=Range("A1:B" & ultimaFila)
[Link] Where:=xlLocationAsObject, Name:=[Link]
MsgBox "Se creó un gráfico de líneas con la evolución de precios.", vbInformation, "Gráfico"
End Sub
Función para calcular el área de un rectángulo
Function AreaRectangulo(base As Double, altura As Double) As Double
AreaRectangulo = base * altura
End Function
Uso en Excel: =AreaRectangulo(5,10) → devuelve 50.
Función para convertir grados Celsius a Fahrenheit
Function CelsiusAFahrenheit(celsius As Double) As Double
CelsiusAFahrenheit = (celsius * 9 / 5) + 32
End Function
Uso en Excel: =CelsiusAFahrenheit(25) → devuelve 77.
Función para calcular el factorial de un número
Function Factorial(n As Integer) As Double
Dim i As Integer
Dim resultado As Double
resultado = 1
For i = 1 To n
resultado = resultado * i
Next i
Factorial = resultado
End Function
Uso en Excel: =Factorial(5) → devuelve 120.
Función para contar vocales en un texto
Function ContarVocales(texto As String) As Integer
Dim i As Integer
Dim contador As Integer
Dim letra As String
contador = 0
texto = UCase(texto)
For i = 1 To Len(texto)
letra = Mid(texto, i, 1)
If letra Like "[AEIOU]" Then
contador = contador + 1
End If
Next i
ContarVocales = contador
End Function
Uso en Excel: =ContarVocales("Hola Mundo") → devuelve 4.
Función para calcular el promedio ponderado
Function PromedioPonderado(valores As Range, pesos As Range) As Double
Dim i As Integer
Dim sumaValores As Double
Dim sumaPesos As Double
For i = 1 To [Link]
sumaValores = sumaValores + valores(i) * pesos(i)
sumaPesos = sumaPesos + pesos(i)
Next i
PromedioPonderado = sumaValores / sumaPesos
End Function
Uso en Excel: =PromedioPonderado(A2:A5,B2:B5) → calcula el promedio ponderado de los
valores en A2:A5 con los pesos en B2:B5.
Botón para limpiar toda la hoja
Private Sub cmdLimpiarHoja_Click()
[Link]
MsgBox "Se ha limpiado toda la hoja.", vbInformation, "Acción completada"
End Sub
Botón para copiar datos a otra hoja
Private Sub cmdCopiarDatos_Click()
Dim ultimaFila As Long
ultimaFila = Cells([Link], 1).End(xlUp).Row
Range("A1:B" & ultimaFila).Copy Destination:=Sheets("Hoja2").Range("A1")
MsgBox "Los datos se copiaron a la Hoja2.", vbInformation, "Acción completada"
End Sub
Botón para imprimir un rango específico
Private Sub cmdImprimirRango_Click()
Dim rango As Range
Set rango = Range("A1:C20")
[Link]
MsgBox "Se imprimió el rango A1:C20.", vbInformation, "Acción completada"
End Sub
Botón para guardar datos en una nueva fila
Private Sub cmdGuardarDatos_Click()
Dim ultimaFila As Long
ultimaFila = Cells([Link], 1).End(xlUp).Row + 1
Cells(ultimaFila, 1).Value = InputBox("Ingrese el nombre:")
Cells(ultimaFila, 2).Value = InputBox("Ingrese la calificación:")
MsgBox "Los datos se guardaron en la fila " & ultimaFila, vbInformation, "Acción
completada"
End Sub
Botón para cerrar el archivo con confirmación
Private Sub cmdCerrarArchivo_Click()
Dim respuesta As Integer
respuesta = MsgBox("¿Desea cerrar el archivo?", vbYesNo + vbQuestion, "Confirmación")
If respuesta = vbYes Then
[Link] SaveChanges:=True
End If
End Sub
Validar que un campo no esté vacío
Private Sub cmdValidarVacio_Click()
Dim dato As String
dato = InputBox("Ingrese un valor:")
If dato = "" Then
MsgBox "El campo no puede estar vacío.", vbExclamation, "Validación"
Else
MsgBox "Dato ingresado: " & dato, vbInformation, "Correcto"
End If
End Sub
Validar que un número esté entre 1 y 100
Private Sub cmdValidarNumero_Click()
Dim numero As Double
numero = InputBox("Ingrese un número entre 1 y 100:")
If numero >= 1 And numero <= 100 Then
MsgBox "Número válido: " & numero, vbInformation, "Validación"
Else
MsgBox "El número debe estar entre 1 y 100.", vbExclamation, "Error"
End If
End Sub
Validar que un correo tenga “@”
Private Sub cmdValidarCorreo_Click()
Dim correo As String
correo = InputBox("Ingrese su correo electrónico:")
If InStr(1, correo, "@") > 0 Then
MsgBox "Correo válido: " & correo, vbInformation, "Validación"
Else
MsgBox "El correo ingresado no es válido.", vbExclamation, "Error"
End If
End Sub
Crear un login básico con usuario y contraseña
Private Sub cmdLogin_Click()
Dim usuario As String
Dim clave As String
usuario = InputBox("Ingrese el usuario:")
clave = InputBox("Ingrese la contraseña:")
If usuario = "admin" And clave = "1234" Then
MsgBox "Acceso concedido.", vbInformation, "Login"
Else
MsgBox "Usuario o contraseña incorrectos.", vbCritical, "Acceso denegado"
End If
End Sub
Bloquear celdas después de ingresar datos
Private Sub cmdBloquearCeldas_Click()
Dim celda As Range
Set celda = ActiveCell
[Link] = InputBox("Ingrese un dato:")
[Link] = True
[Link] Password:="seguro"
MsgBox "La celda se bloqueó después de ingresar el dato.", vbInformation, "Seguridad"
End Sub