Macros personalizadas en

Excel
Macros y VBA en Excel 2016

12/17/2021 Prof. Elvis López Loza Movil: 917799708 1

mi primera Macro
• Editor de Visual Basic
• Alt+F11
• Barra de Herramientas: Visual Basic
• Herramientas, Macro, Editor de V.B.
• Insertar Módulo
• Primera macro

Sub Hola_Mundo()
ActiveCell.Value = "Hola Mundo"
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 2

Objeto Rango
• Programa que deja un valor en una celda y modifica su
formato

Sub Saludo()
Worksheets("Hoja2").Activate
ActiveSheet.Range("C5").Value = "¿Cómo esta usted?"
ActiveSheet.Range("C5").Font.Bold = True
ActiveSheet.Range("C5").Font.Color = RGB(255, 0, 0)
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 3

 Range y Offset
Sub primero()
'Queremos asignar un valor al objeto Range
Range("B10").Value = "Hola"
' Otra forma de trabajar es poniendo el objeto WorkSheets que está por encima de Range
Worksheets(1).Range("B11").Value = "¿Qué tal?"
' Y aún podemos poner los objetos superiores
' Application que hace referencia a la aplicación Excel
' Y WorkBooks que se refiere al libro de trabajo
Application.Workbooks(1).Worksheets(1).Range("B12").Value = "Felicidades"
Application.Workbooks("Mac01.xls").Worksheets("Hoja1").Range("B13").Value = "América"
' Application normalmente no se pone porque todo cuelga de Excel
' WorkBooks conviene ponerlo cuando se trabaja con varios libros
' WorkSheet conviene si se trabaja con varias hojas, aunque muchas veces no se pone
Range("B14").Value = 8.6 'Los decimales con punto
Range("B15").Select
Application.ActiveWindow.ActiveCell.Value = "Adios"
' Señale con el ratón ActiveWindow y pulse F1 que es la ayuda
ActiveCell.Offset(1, 0).Value = "Bye"
ActiveCell.Offset(2, 0).Activate
ActiveCell.Value = "Hasta la vista"
ActiveSheet.Range("A1").Offset(17, 1).Value = "100%"
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 4

La Estructura With - End With
• Sirve para ejecutar una serie de acciones sobre un mismo Objeto, sin
tener que repetir toda su jerarquía
• Ej.: Propiedades del objeto Range

Sub Escribe()
ActiveSheet.Range("C7").Value = "Cta. Resultados"
ActiveSheet.Range("C7").Font.Bold = True
ActiveSheet.Range("C7").Font.Color = RGB(0, 255, 0)
End Sub

Sub Escribe_bis()
With ActiveSheet.Range("C7")
.Value = "Cta. Resultados"
.Font.Bold = True
.Font.Color = RGB(0, 255, 0)
End With
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 5

Dim e InputBox
• Option Explicit sirve para que nos obliguemos ha definir todas las variables
• Dim permite definir el tipo de variable
• Si no se definen las variables se toman como VARIAN que son las que más ocupan
• InputBox permite capturar datos del usuario
• InputBox devuelve siempre datos tipo String
• Chr(13) es para cambiar de línea

Option Explicit

Sub Entrar_Valor()
Dim Texto As String
Texto = InputBox("Introducir un texto" & Chr(13) & "Para la Casilla D10", "Entrada de
Datos")
ActiveSheet.Range("D10").Value = Texto
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 6

Dim e InputBox
InputBox(Mensaje, Título, Valor por defecto, Posición horizontal, Posición Vertical, Archivoayuda,
Número de contexto para la ayuda)

Sub Entrar_Valor_Bis()
'Este procedimiento es igual que el anterior pero no utiliza variables
ActiveSheet.Range("D11").Value _
= InputBox("Introducir un texto " & Chr(10) & "Para la casilla D11", "Entrada de datos")
'El guión bajo permite partir una línea de código demasiado larga. Ver Chr(10)
End Sub

Sub Entrar_Valor_Tris()
'En este caso se pide al usuario que entre la casilla donde se introducirá el texto
Dim Casilla As String 'Casilla puede ser por ejemplo D12
Dim Texto As String
Casilla = InputBox("En que casilla quiere entrar el valor", "Entrar Casilla")
Texto = InputBox("Introducir un texto" & Chr(13) _
& "Para la casilla " & Casilla, "Entrada de datos") ‘ Operador de concatenación &
ActiveSheet.Range(Casilla).Value = Texto
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 7

 Tipos de variables
Tipo de datos Tamaño de almacenamiento Intervalo
Byte 1 byte 0 a 255
Boolean 2 bytes True o False
Integer 2 bytes -32.768 a 32.767
Long (entero largo) 4 bytes -2.147.483.648 a 2.147.483.647
-3,402823E38 a -1,401298E-45 para valores negativos;
Single (coma flotante/precisión
4 bytes 1,401298E-45 a 3,402823E38 para valores
simple)
positivos
-1,79769313486232E308 a -4,94065645841247E-324
Double (coma flotante/precisión
8 bytes para valores negativos; 4,94065645841247E-324
doble)
a 1,79769313486232E308 para valores positivos
-922.337.203.685.477,5808 a
Currency (entero a escala) 8 bytes
922.337.203.685.477,5807
+/-79.228.162.514.264.337.593.543.950.335 sin punto
decimal; +/-7,9228162514264337593543950335
Decimal 14 bytes con 28 posiciones a la derecha del signo decimal;
el número más pequeño distinto de cero es +/-
0,0000000000000000000000000001
Date 8 bytes 1 de enero de 100 a 31 de diciembre de 9999
Object 4 bytes Cualquier referencia a tipo Object
String (longitud variable) 10 bytes + longitud de la cadena Desde 0 a 2.000 millones
String (longitud fija) Longitud de la cadena Desde 1 a 65.400 aproximadamente
Cualquier valor numérico hasta el intervalo de un tipo
Variant (con números) 16 bytes
Double
El mismo intervalo que para un tipo String de longitud
Variant (con caracteres) 22 bytes + longitud de cadena
variable
Definido por el usuario (utilizando Número requerido por los El intervalo de cada elemento es el mismo que el
Type) elementos intervalo de su tipo de datos.
12/17/2021 Prof. Elvis López Loza Movil: 917799708 8
Ejercicio 1
• Crear un libro llamado “Rellena.xls”
• Programar un procedimiento que nos pregunte en que hoja queremos situarnos
• Nos pregunte en que celda queremos situarnos
• Nos pregunte lo que queremos escribir
• El programa pone lo que hemos dicho y lo pone de color verde y cursiva, sobre
fondo rojo
• Pista: ActiveCell.Interior.Color=RGB(x,y,z)
• Ejecute el programa
• Primero, dando una sola celda
• Segundo. Cuando pida la celda introduzca un rango para ver como funciona Range
• ¿Ha usado With – End With?

12/17/2021 Prof. Elvis López Loza Movil: 917799708 9

 Suma dos números
 Val(Cadena). Convierte la cadena a un valor numérico
 Str(Número). Convierte el número a una expresión cadena
 CBool, CByte, CCur, CCur, CDate, CDec, CInt, CLng, CSng, CStr, CVar

Sub Sumar()
'Pide dos números y pone en una celda su suma
'Dim Numero1 As Integer
'Dim Numero2 As Integer
Numero1 = InputBox("Entrar el primer valor", "Entrada de datos")
Numero2 = InputBox("Entrar el segundo valor", "Entrada de datos")
Worksheets("Hoja1").Activate 'Esto se pone por si estamos en una hoja distinta de la Hoja1
ActiveSheet.Range("E10").Value = Numero1 + Numero2
End Sub

Sub Sumar_Bis()
'Este procedimiento es similar al anterior
'En el procedimiento anterior si se mete como variable una palabra, da error.
'Por eso en este procedimiento añadimos la función Val
Dim Numero1 As Integer
Dim Numero2 As Integer
Numero1 = Val(InputBox("Entrar el primer valor", "Entrada de datos"))
Numero2 = Val(InputBox("Entrar el segundo valor", "Entrada de datos"))
ActiveSheet.Range("E11").Value = Numero1 + Numero2
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 10

Ejercicio 2
• El siguiente programa no funciona bien
• El área del un rectángulo de base 4,5 y altura 5,5 es 24,75
• Pero este programa da 24. El problema es que no da ERROR
• Modifique el código del procedimiento para solucionarlo

Sub area()
Dim base As Integer
Dim altura As Integer
Dim superficie As Integer
'Los decimales se introducen con coma en un inputbox, y con punto en el código
altura = InputBox("Introduzca la altura del rectángulo")
base = InputBox("Introduzca la base del rectángulo")
superficie = base * altura
MsgBox ("El área del rectángulo es " & superficie)
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 11

Public – Private. Cells
• Public. Indica que el procedimiento Sub es accesible para todos los demás
procedimientos de todos los módulos
• Private. Indica que el procedimiento Sub es accesible sólo para otros
procedimientos del módulo en el que se declara
• Por defecto los procedimientos son Public
• Cells comienza a contar filas y columnas a partir del rango especificado en el
objeto Range
Cells(fila,columna)
Private Sub Celda()
Cells(12, 3).Value = "Solo " & 2
ActiveSheet.Cells(10, 6).Value = "Paris"
'La Celda 10,6 es la F10
Range("C13:D14").Value = "Cuadrado"
Range(Cells(15, 3), Cells(16, 4)).Value = "Cubo"
Range("C17:F20").Cells(2, 1).Value = "Elipse" 'Esto solo pone una elipse
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 12

Variables de objetos
• Una variable objeto sirve para hacer referencia a un objeto, esto significa que podremos acceder a
las propiedades de un objeto e invocar sus métodos a través de la variable en lugar de hacerlo
directamente a través del objeto.
• Para declarar una variable objeto se utiliza también la palabra Dim
Dim Var_Objeto As Objeto
• Por Ejemplo
Dim R As Range
Dim Hoja As WorkSheet
• Para asignar un objeto a una variable debe utilizar la instrucción Set.
Set Variable_Objeto = Objeto
• Por Ejemplo
Set R= ActiveSheet.Range("A1:B10")
Set Hoja = ActiveSheet
Set Hoja = WorkSheets(1)
• A veces pude ser interesante desasignar una variable objeto
Dim Var_Objeto = Nothing

12/17/2021 Prof. Elvis López Loza Movil: 917799708 13

Variables de objetos
 Posiblemente no se utilice demasiado esta clase de variables
(dependerá de las preferencias del programador), pero hay casos en
los que no hay más remedio que utilizarlas, por ejemplo en
estructuras For Each ... Next como veremos, o cuando sea necesario
construir funciones que devuelvan rangos, referencias a hojas, etc.

Sub objeto()
Dim R As Range
Set R = ActiveSheet.Range("H21:I22")
R.Value = "Roma"
R.Font.Bold = True
R.Font.Color = RGB(0, 255, 100)
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 14

Estructuras Condicionales
If Condición Then
Senténcia1
Senténcia2
.
.
SenténciaN
End If
Sub Condicional()
ActiveSheet.Range("E14").Value = 0
ActiveSheet.Range("E15").Value = 0
ActiveSheet.Range("E16").Value = 0
ActiveSheet.Range("E14").Value = Val(InputBox("Entrar el precio", "Entrar"))
'Si el valor de la casilla E14 es mayor que 1000, entonces pedir descuento
If ActiveSheet.Range("E14").Value > 1000 Then
ActiveSheet.Range("E15").Value = Val(InputBox("Entrar Descuento", "Entrar"))
End If
ActiveSheet.Range("E16").Value = _
ActiveSheet.Range("E14").Value - ActiveSheet.Range("E15")
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 15

Estructuras Condicionales
Sub Condicional_Bis()
'Igual que el procedimiento anterior pero ahora usando variables
Dim Precio As Integer
Dim Descuento As Integer
Precio = 0
Descuento = 0
Precio = Val(InputBox("Entrar el precio", "Entrar"))
' Si el valor de la variable precio es mayor que 1000, entonces, pedir descuento
If Precio > 1000 Then
Descuento = Val(InputBox("Entrar descuento", "Entrar"))
End If
ActiveSheet.Range("F14").Value = Precio
ActiveSheet.Range("F15").Value = Descuento
ActiveSheet.Range("F16").Value = Precio - Descuento
End Sub

Sub Condicional2()
If ActiveSheet.Range("F14").Value = ActiveSheet.Range("F16").Value Then
ActiveSheet.Range("F14").Font.Color = RGB(0, 0, 255)
ActiveSheet.Range("F16").Font.Color = RGB(0, 0, 255)
End If
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 16

Estructuras Condicionales. Else
Sub Condicional_Else()
Dim Precio As Single
Dim Descuento As Single
Precio = 0
Descuento = 0
Precio = Val(InputBox("Entrar el precio", "Entrar"))
' Si el valor de la variable precio es mayor que 1000, entonces, aplicar descuento del 10%
If Precio > 1000 Then
Descuento = Precio * (10 / 100)
ActiveSheet.Range("G13").Value = 0.1
Else ' Sino Aplicar descuento del 5%
Descuento = Precio * (5 / 100)
ActiveSheet.Range("G13").Value = 0.05
End If
ActiveSheet.Range("G14").Value = Precio
ActiveSheet.Range("G15").Value = Descuento
ActiveSheet.Range("G16").Value = Precio - Descuento
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 17

 Estructuras Condicionales. Else
Sub Condicional_Else2()
'Ponga valores en G10 y en G11.
'La macro calcula la diferencia la pone en G12 y asigna color
ActiveSheet.Range("G12").Value = ActiveSheet.Range("G10").Value -
ActiveSheet.Range("G11").Value
If Range("G12").Value < 0 Then
'Si la diferencia es negativa pone color rojo
ActiveSheet.Range("G12").Font.Color = RGB(255, 0, 0)
Else
'En caso contrario pone color azul
ActiveSheet.Range("G12").Font.Color = RGB(0, 0, 255)
End If
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 18

 El valor Nothing
 Algunas veces puede que sea necesario desasignar una variable del objeto al cual hace
referencia, en este caso debe igualar la variable al valor Nothing de la forma siguiente.
Set Variable_Objeto = Nothing
 Habitualmente se utiliza Nothing en una estructura condicional para comprobar si la variable
objeto está asignada. Observe que si se utiliza una variable objeto a la cual todavía no se le ha
hecho ninguna asignación el programa dará error y detendrá su ejecución. Es buena práctica
hacer este tipo de comprobaciones antes de trabajar con variables objeto.

Sub objeto_Bis()
Dim R As Range
Set R = ActiveSheet.Range("E12:F13")
R.Value = "Milan"
R.Font.Bold = True
Set R = Nothing 'Nothing permite asigna a la variable objeto un valor nulo.
' Esto es útil junto con un IF para verificar si la variable esta asignada
If R Is Nothing Then
MsgBox Prompt:="La variable Objeto no ha sido asignada", Buttons:=vbOK, _
Title:="Error"
Else
R.Value = "Hola"
End If
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 19

Condicionales anidadas
Sub Condicional_doble()
Dim a As Integer
Dim b As Integer
Dim C As String
a = ActiveSheet.Range("G10").Value
b = ActiveSheet.Range("G11").Value
If a = b Then
C = "Los valores de G10 y G11 son iguales"
Else
If a > b Then
C = "G10 es mayor que G11"
Else
C = "G10 es menor que G11"
End If
End If
ActiveSheet.Range("G9").Value = C
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 20

ElseIf
 El procedimiento anterior se puede abreviar con un EsleIf
If condición 1 Then Sub Condicional_doble_2()
Sentencia 1 Dim a As Integer
Sentencia 2 Dim b As Integer
ElseIf condición 2 Then Dim C As String
Sentencia 3 a = ActiveSheet.Range("G10").Value
Sentencia 4 b = ActiveSheet.Range("G11").Value
ElseIf condición 3 Then If a = b Then
Sentencia 5 C = "Los valores de G10 y G11 son iguales“
Sentencia 6 'ElseIf abrevia dos condicuonales anidados
ElseIf condición 4 Then ElseIf a > b Then
Sentencia 7 C = "G10 es mayor que G11"
Sentencia 8 Else
Else C = "G10 es menor que G11"
Sentencia 9 End If
Sentencia 10 ActiveSheet.Range("G9").Value = C
EndIf End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 21

 Operador Lógico AND
Sub YAcero() 'Uso del condicional AND
Dim Producto As String, Cantidad As String, Precio As Single
Dim Total As Single, Descuento As Single, Total_Descuento As Single
Precio = 0 'UCase convierte a mayúsculas
Producto = UCase(InputBox("Entrar nombre del Producto", "Entrar"))
Precio = Val(InputBox("Entrar Precio", "Entrar"))
Cantidad = Val(InputBox("Entrar Cantidad", "Entrar"))
Total = Precio * Cantidad
ActiveSheet.Range("H10").Value = Producto
ActiveSheet.Range("H11").Value = Precio
ActiveSheet.Range("H12").Value = Cantidad
ActiveSheet.Range("H13").Value = Total
'Si el Total es mayor que 10000 y el producto es Acero, aplicar descuento
If Total > 10000 And Producto = "ACERO" Then
Descuento = Val(InputBox("Entrar Descuento", "Entrar"))
Total_Descuento = Total * (Descuento / 100)
Total = Total - Total_Descuento
ActiveSheet.Range("H14").Value = Total_Descuento
ActiveSheet.Range("H15").Value = Total
End If
Range("H12").NumberFormat = "#,##0“'Formato de Celdas
Range("H11,H13,H14,H15").NumberFormat = "#,##0.00 $"
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 22

 Operador Lógico OR
Sub OAcero() ' Condicional OR
Dim Producto As String, Cantidad As Integer, Precio As Single
Dim Total As Single, Descuento As Single, Total_Descuento As Single
Precio = 0
'LCase convierte a minúsculas
Producto = LCase(InputBox("Entrar Nombre del Producto", "Entrar"))
Precio = Val(InputBox("Entrar el Precio", "Entrar"))
Cantidad = Val(InputBox("Entrar la Cantidad", "Entrar"))
Total = Precio * Cantidad
ActiveSheet.Range("I10").Value = Producto
ActiveSheet.Range("I11").Value = Precio
ActiveSheet.Range("I12").Value = Cantidad
ActiveSheet.Range("I13").Value = Total
'si Total es mayor de 10.000 o el producto es Acero, aplicar descuento
If Total > 10000 Or Producto = “acero" Then
Descuento = Val(InputBox("Entrad Descuento", "Entrar"))
Total_Descuento = Total * (Descuento / 100)
Total = Total - Total_Descuento
ActiveSheet.Range("I14").Value = Total_Descuento
ActiveSheet.Range("I15").Value = Total
End If
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 23

 Operador Lógico NOT
Sub operadorNO()
Dim Precio As Integer
Dim Descuento As Integer
Precio = 0
Descuento = 0
Precio = Val(InputBox("Entrar el Precio", "Entrar"))
' Si el valor de la variable precio NO es menor o igual que
1000,
' entonces pedir descuento
If Not Precio <= 1000 Then
Descuento = Val(InputBox("Entrar Descuento", "Entrar"))
End If
ActiveSheet.Range("B19").Value = Precio
ActiveSheet.Range("B20").Value = Descuento
ActiveSheet.Range("B21").Value = Precio - Descuento
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 24

Tablas de Verdad

A B C NO(A) Y(A;B;C) O(A;B;C)

VERDADERO VERDADERO VERDADERO FALSO VERDADERO VERDADERO

VERDADERO VERDADERO FALSO FALSO FALSO VERDADERO

VERDADERO FALSO VERDADERO FALSO FALSO VERDADERO

VERDADERO FALSO FALSO FALSO FALSO VERDADERO

FALSO VERDADERO VERDADERO VERDADERO FALSO VERDADERO

FALSO VERDADERO FALSO VERDADERO FALSO VERDADERO

FALSO FALSO VERDADERO VERDADERO FALSO VERDADERO

FALSO FALSO FALSO VERDADERO FALSO FALSO

12/17/2021 Prof. Elvis López Loza Movil: 917799708 25

 Calculadora
 Macro que suma, resta, multiplica o divide los valores de las casillas C19 y C20 dependiendo de si C21 contiene
el signo +, -, x, :
 El resultado lo deja en C22. Si en C21 no hay ninguno de los signos anteriores en C22 debe dejarse un 0

Sub Calculadora()
Dim Signo As String * 1 'Un solo carácter alfanumérico
Dim Valor1 As Integer, Valor2 As Integer, Total As Integer
Valor1 = ActiveSheet.Range("C19").Value
Valor2 = ActiveSheet.Range("C20").Value
Signo = ActiveSheet.Range("C21").Value
Total = 0
If Signo = "+" Then
Total = Valor1 + Valor2
End If
If Signo = "-" Then
Total = Valor1 - Valor2
End If
If Signo = "x" Then
Total = Valor1 * Valor2
End If
If Signo = ":" Then
Total = Valor1 / Valor2
End If
ActiveSheet.Range("C22").Value = Total
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 26

 La estructura Select Case
 La estructura Select Case da mayor legibilidad al programa anterior

Sub calcula_case()
Dim Signo As String * 1
Dim Valor1 As Integer, Valor2 As Integer, Total As Integer
Valor1 = ActiveSheet.Range("D19").Value
Valor2 = ActiveSheet.Range("D20").Value
Signo = ActiveSheet.Range("D21").Value
Select Case Signo
Case "+"
Total = Valor1 + Valor2
Case "-"
Total = Valor1 - Valor2
Case "x"
Total = Valor1 * Valor2
Case “:"
Total = Valor1 / Valor2
Case Else
Total = 0
End Select
ActiveSheet.Range("D22").Value = Total
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 27

Ejercicio
• Cree un programa que pregunte la fecha de nacimiento, calcule
cuantos días han transcurrido hasta el momento actual y diga en qué
día de la semana nació.

12/17/2021 Prof. Elvis López Loza Movil: 917799708 28

 Solución Ejercicio
Sub nacimiento()
Dim dias As Integer, Dsemana As Integer, Factual As Date, d As String
'Dsemana es una variable que da un número que indica el día de la semana
'dado por la función WEEKDAY, que en Excel es =DIASEM(fecha)
Static Fnacimiento As Date
Factual = Date 'Date es la función de VBA equivalente a =HOY()
Fnacimiento = Factual
Fnacimiento = InputBox(Prompt:="Introduzca su fecha de nacimiento", Title:="Formato DD-MM-AAAA",
Default:=Fnacimiento)
dias = Factual - Fnacimiento
Dsemana = Application.WorksheetFunction.Weekday(Fnacimiento)
Select Case Dsemana
Case 1: d = "Domingo"
Case 2: d = "Lunes"
Case 3: d = "Martes"
Case 4: d = "Miercoles"
Case 5: d = "Jueves"
Case 6: d = "Viernes"
Case 7: d = "Sabado"
End Select
MsgBox Prompt:="Usted nació un " & d & " hace " & dias & " días" & Chr(10), Title:="Esta información es
correcta siempre que hoy sea " & Factual
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 29

 Cada sentencia Case evalúa un rango de valores
Sub Media()
Dim Nota1 As Single, Nota2 As Single, Nota3 As Single
Dim califica As String, Media As Single
Nota1 = CSng(InputBox("Entrar Nota primera evaluación", "Nota"))
Nota2 = CSng(InputBox("Entrar Nota Segunda evaluación", "Nota"))
Nota3 = CSng(InputBox("Entrar Nota Tercera evaluación", "Nota"))
Media = (Nota1 + Nota2 + Nota3) / 3
ActiveSheet.Range("C17").Value = Nota1
ActiveSheet.Range("D17").Value = Nota2
ActiveSheet.Range("E17").Value = Nota3
ActiveSheet.Range("D18").Value = Media
Select Case Media
Case Is < 5
califica = "Suspenso"
Case 5 To 6.99
califica = "Aprobado"
Case 6.99 To 8.99
califica = "Notable"
Case Is > 8, 99
califica = "Sobresaliente"
End Select
ActiveSheet.Range("E18").Value = califica
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 30

 Cada sentencia Case evalúa un rango de valores
Sub Media()
Dim Nota1 As Single, Nota2 As Single, Nota3 As Single
Dim califica As String, Media As Single
Nota1 = CSng(InputBox("Entrar Nota primera evaluación", "Nota"))
Nota2 = CSng(InputBox("Entrar Nota Segunda evaluación", "Nota"))
Nota3 = CSng(InputBox("Entrar Nota Tercera evaluación", "Nota"))
Media = (Nota1 + Nota2 + Nota3) / 3
ActiveSheet.Range("C17").Value = Nota1
ActiveSheet.Range("D17").Value = Nota2
ActiveSheet.Range("E17").Value = Nota3
ActiveSheet.Range("D18").Value = Media
Select Case Media
Case Is < 5
califica = "Suspenso"
Case 5 To 6.99
califica = "Aprobado"
Case 6.99 To 8.99
califica = "Notable"
Case Is > 8, 99
califica = "Sobresaliente"
End Select
ActiveSheet.Range("E18").Value = califica
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 31

 Select Case y Filtros
Sub con_case_y_filtro() If IsEmpty(ActiveSheet.Range("E21")) Then
Dim Signo As String MsgBox Prompt:="la casilla E21 está vacía",
Dim Valor1 As Variant, Valor2 As Variant, Total As Title:="ERROR"
Single Continuar = False
Dim Continuar As Boolean End If
Valor1 = ActiveSheet.Range("E19").Value If Continuar Then
Valor2 = ActiveSheet.Range("E20").Value Select Case Signo
Signo = ActiveSheet.Range("E21").Value Case "+"
Continuar = True Total = Valor1 + Valor2
' Si en la casilla E19 no hay un valor numérico Case "-"
If Not IsNumeric(ActiveSheet.Range("E19")) Then Total = Valor1 - Valor2
MsgBox Prompt:="En E19 no hay ningún valor Case "x"
numérico", Title:="ERROR" Total = Valor1 * Valor2
Continuar = False Case "/"
End If Total = Valor1 / Valor2
' Si en la casilla E20 no hay un valor numérico Case Else
If Not IsNumeric(ActiveSheet.Range("E20")) Then Total = 0
MsgBox Prompt:="En E20 no hay ningún valor End Select
numérico", Title:="ERROR" ActiveSheet.Range("E22").Value = Total
Continuar = False End If
End If End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 32

Lista de Funciones de Comprobación
• IsNuméric(Expresión)
• Comprueba si expresión tiene un valor que se puede interpretar como 'numérico.
• IsDate(Expresión)
• Comprueba si expresión tiene un valor que se puede interpretar como tipo fecha.
• IsEmpty(Expresión)
• Comprueba que expresión tenga algún valor, que se haya inicializado.
• IsError(Expresión)
• Comprueba si expresión devuelve algún valor de error.
• IsArray(Expresión)
• Comprueba si expresión (una variable) es un array o no.
• IsObject(Expresión)
• Comprueba si expresión (una variable) representa una variable tipo objeto.
• IsNull(Expresión)
• Comprueba si expresión contiene un valor nulo debido a datos no válidos.
• Nothing
• No es propiamente una función, sirve para comprobar si una variable objeto esta 'asociada a un objeto antes de hacer
cualquier operación con ella. Recuerde que para trabajar con 'una variable objeto antes debe asignarse a uno (mediante
la instrucción Set), en caso contrario se producirá un error en el programa cuando utilice el objeto y se detendrá su
ejecución.

12/17/2021 Prof. Elvis López Loza Movil: 917799708 33

 Select Case y Filtro
Sub con_case_y_filtro_Bis()
' En lugar de los tres If de comprobación se puede utilizar el operador OR de la manera siguiente
Dim Signo As String
Dim Valor1 As Variant, Valor2 As Variant, Total As Single
Dim Continuar As Boolean
Valor1 = ActiveSheet.Range("F19").Value
Valor2 = ActiveSheet.Range("F20").Value
Signo = ActiveSheet.Range("F21").Value
Continuar = True
' Si en la casilla F19 no hay un valor numérico
If Not IsNumeric(ActiveSheet.Range("F19")) Or Not IsNumeric(ActiveSheet.Range("F20")) Or
IsEmpty(ActiveSheet.Range("F21")) Then
MsgBox Prompt:="Debe entrar número en F19, F20 y un signo (+,-,x,/) en F21", Title:="ERROR"
Else
Select Case Signo
Case "+“: Total = Valor1 + Valor2
Case "-“: Total = Valor1 - Valor2
Case "x“: Total = Valor1 * Valor2
Case "/“: Total = Valor1 / Valor2
Case Else: Total = 0
End Select
ActiveSheet.Range("F22").Value = Total
End If
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 34

 La función MsgBox (F1)
 Muestra un mensaje en un cuadro de diálogo hasta que el usuario pulse un
botón. La función devuelve un dato tipo Integer en función del botón pulsado por
el usuario. A la hora de invocar está función, se permiten diferentes tipos de
botones.
MsgBox( Mensaje, Botones, Título, Archivo de ayuda, contexto)
 Mensaje: Obligatorio, es el mensaje que se muestra dentro del cuadro de
diálogo.
 Botones: Opcional. Es un número o una suma de números o constantes, que
sirve para mostrar determinados botones e iconos dentro del cuadro de diálogo.
Si se omite este argumento asume valor 0 que corresponde a un único Botón OK.
 Título : Opcional. Es el texto que se mostrará en la barra del título del cuadro de
diálogo.
MsgBox Prompt:="En la casilla A1 no hay ningún valor numérico", Title:="ERROR"
MsgBox Prompt := "La variable Objeto no ha sido asignada", Buttons:=vbOk, Title := "Error"
X= MsgBox ("Hola usuario, Ha acabado el proceso", VbOkOnly, "Mensaje")
X=MsgBox("Desea Continuar", vbYesNo + vbQuestion, "Opción",,)
Mas_datos = MsgBox("Otro registro ?", vbYesNo+vbQuestion,"Entrada de datos")
MsgBox Prompt:=Texto, Buttons:=vbOKOnly + vbInformation, Title:=Titulo
MsgBox ("Debe introducir valores numéricos")

12/17/2021 Prof. Elvis López Loza Movil: 917799708 35

 MsgBox
Sub MesajeCaja()
Dim nom As String, Respuesta As Integer
nom = "Antonio"
MsgBox ("Hola " & nom) 'Se pueden poner paréntesis o no
MsgBox "Hola " & nom
MsgBox "Mire el Título", , "Aqui se puede poner el título que se desee"
MsgBox "Observe este texto" & vbCrLf & "que ocupa" & vbCrLf & "tres líneas",, "Título"
MsgBox "Mire el icono de" & vbCrLf & "Interrogación", vbQuestion, _
"Icono de Interrogación"
MsgBox "Otro icono", vbCritical, "Icono Crítico" 'Sonido
MsgBox "Otro", vbExclamation, "Icono Exclamación" 'Sonido
MsgBox "Otro más", vbInformation, "Icono Información" 'Sonido
Respuesta = MsgBox("Observe que al incluir más" & vbCrLf & _
"de un botón, en el MsgBox" & vbCrLf & "pongo paréntesis y utilizo" _
& vbCrLf & "una variable que recogerá" & vbCrLf & "el botón que hemos pulsado", _
vbYesNo + vbQuestion, "Dos Botones")
MsgBox "La Respuesta ha sido " & Respuesta, , "Respuesta"
Respuesta = MsgBox("Tres Botones", vbYesNoCancel + vbInformation, _
"Con icono de Información") 'Con paréntesis necesariamente
MsgBox "La Respuesta ha sido " & Respuesta, , "Respuesta"
Respuesta = MsgBox("Tres Botones pero" & vbCrLf & "el activo es el segundo", _
vbAbortRetryIgnore + vbCritical + vbDefaultButton2, "Icono Crítico")
MsgBox "La Respuesta ha sido " & Respuesta, , "Respuesta"
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 36

InputBox
• Variable = InputBox (mensaje, Titulo, Defecto, Coordenada Horizontal,
Coordenada Vertical)
• Las coordenadas se miden en Twips desde el extremo superior izquierdo de la
ventana
• 1 cm = 566 Twips
• 1 pixel = 15 Twips

Sub InputCaja()
Dim Respuesta As String
Respuesta = InputBox("Primera Línea" & vbCrLf & Chr(9) _
& "Segunda Línea con Tabulador Chr(9)", "Aquí el Título") 'Chr(10) equivale a vbCrLf
Respuesta = InputBox("Haz clic en [Cancel]", "A ver que pasa si se cacela")
MsgBox "Al pulsar Calcelar el resultado es = " & Respuesta 'Respuesta nula ""
Respuesta = InputBox("Aparece un valor por defecto", "Título", "Aparece esto por defecto")
Respuesta = InputBox("Situo la ventana", "1200 Twips a la derecha y 1400 hacia abajo", "coordenadas
1200x1400", 1200, 1400)
Respuesta = InputBox("Otra posición", , "1 cm = 566 Twips y 1 pixel = 15 Twips", 50, 75)
End Sub

12/17/2021 Prof. Elvis López Loza Movil: 917799708 37

 La instrucción With (repaso)
Sub OAcero_with() ' Si total mayor que 10.000 o el producto es Acero,
Dim Producto As String aplicar descuento.
Dim Cantidad As Integer If Total > 10000 Or Producto = "Acero" Then
Dim Precio As Single Descuento = Val(InputBox("Entrar Descuento",
Dim Total As Single "Entrar"))
Dim Descuento As Single Total_Descuento = Total * (Descuento / 100)
Dim Total_Descuento As Single Total = Total - Total_Descuento
Precio = 0 With ActiveSheet
Producto = LCase(InputBox("Entrar Nombre del .Range("J14").Value = Total_Descuento
Producto", "Entrar")) .Range("J15").Value = Total
Precio = Val(InputBox("Entrar el precio", "Entrar")) End With
Cantidad = Val(InputBox("Entrar la cantidad", "Entrar")) End If
Total = Precio * Cantidad End Sub
With ActiveSheet
.Range("J10").Value = Producto
.Range("J11").Value = Precio
.Range("J12").Value = Cantidad
.Range("J13").Value = Total
End With

12/17/2021 Prof. Elvis López Loza Movil: 917799708 38