Ejemplos de MACROS en VBA

[Ayudante De Santa]

[ARICARRARO]

Algunos ejemplos del uso de macros en VB6

1. Calcular el interés compuesto
'hacer aparecer macro(en la hoja)
Private Sub CommandButton1_Click()
Beep
UserForm1.Show
End Sub
'en un formulario
Option Explicit
'------------------------------------------------------
' Autor: Fernando Carraro Aguirre
' Programación en Excel
' M A C R O S
'------------------------------------------------------
Dim prestamo As Double, tasa As Double, Ic As Double
Dim periodo As Integer, i As Integer
Private Sub CommandButton1_Click()
prestamo = Val(TextBox1.Text): tasa = Val(TextBox2.Text): periodo =
Val(TextBox3.Text)
For i = 1 To periodo
Ic = prestamo * (1 + tasa / 100) ^ i
ListBox1.AddItem Ic
ListBox2.AddItem i
ActiveSheet.Cells(i, 7).Value = i
Next i
ActiveSheet.Range("a1").Value = "Préstamo"
ActiveSheet.Range("b1").Value = prestamo
ActiveSheet.Range("c1").Value = "Tasa"
ActiveSheet.Range("d1").Value = tasa / 100
ActiveSheet.Range("e1").Value = "Periodo"
ActiveSheet.Range("f1").Value = periodo
End Sub
Private Sub CommandButton2_Click()
TextBox1.Text = "": TextBox2.Text = "": TextBox3.Text = "":
TextBox1.SetFocus: ListBox1.Clear: ListBox2.Clear
ActiveSheet.Range("a1").Value = Empty
ActiveSheet.Range("b1").Value = Empty
ActiveSheet.Range("c1").Value = Empty
ActiveSheet.Range("d1").Value = Empty
ActiveSheet.Range("e1").Value = Empty
ActiveSheet.Range("f1").Value = Empty
ActiveSheet.Range("g1").Value = Empty
ActiveSheet.Range("g2").Value = Empty
ActiveSheet.Range("g3").Value = Empty
ActiveSheet.Range("g4").Value = Empty
ActiveSheet.Range("g5").Value = Empty
ActiveSheet.Range("g6").Value = Empty
ActiveSheet.Range("g7").Value = Empty
ActiveSheet.Range("g8").Value = Empty
ActiveSheet.Range("g9").Value = Empty
ActiveSheet.Range("g10").Value = Empty
ActiveSheet.Range("g11").Value = Empty
ActiveSheet.Range("g12").Value = Empty
ActiveSheet.Range("g13").Value = Empty
ActiveSheet.Range("g14").Value = Empty
ActiveSheet.Range("g15").Value = Empty
ActiveSheet.Range("g16").Value = Empty
ActiveSheet.Range("g17").Value = Empty
ActiveSheet.Range("g18").Value = Empty
ActiveSheet.Range("g19").Value = Empty
ActiveSheet.Range("g20").Value = Empty
ActiveSheet.Range("g21").Value = Empty
ActiveSheet.Range("g22").Value = Empty
ActiveSheet.Range("g23").Value = Empty
ActiveSheet.Range("g24").Value = Empty
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub

2. Calcular una función
'en la hoja
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub
'En un módulo .bas
Option Explicit
'Autor:Fernando Carraro Aguirre
'Función que calcula el factorial de un número
Function factorial(n As Integer) As Long
If n = 0 Then
factorial = 1
Else
factorial = n * factorial(n - 1)
End If
End Function
'calcula la función(x)
Function funcion(x As Double) As Double
If x <= 0 Then
MsgBox "Error x no bebe ser cero o igual a cero", vbCritical, "Aviso"
End If
funcion = 5 * x ^ 3 + 2 * x ^ 2 - 3 * x - 15
End Function
'aqui va la función para la hoja no. 2
'CONTABILIDAD BÁSICA
'Activo
Public Function calculoActivo(pasivo As Double, capital As Double) As Double
calculoActivo = pasivo + capital
End Function
'Pasivo
Public Function calculoPasivo(activo As Double, capital1 As Double) As Double
calculoPasivo = activo - capital1
End Function
'Capital
Public Function calculoCapital(activo1 As Double, pasivo1 As Double) As Double
calculoCapital = activo1 - pasivo1
End Function
'en un formulario
Option Explicit
Dim numero As Integer, valorX As Double
Dim contador As Integer
Dim resultado As Double
Private Sub CommandButton1_Click()
End
End Sub
Private Sub CommandButton2_Click()
numero = Val(TextBox1.Text)
contador = 0: resultado = 0
For contador = 1 To numero
valorX = Val(InputBox("Valor del elemento" & contador, " Introduce valor", ""))
resultado = funcion(valorX)
'resultados
ListBox1.AddItem (valorX)
ListBox2.AddItem (resultado)
ListBox3.AddItem (contador)
Next
End Sub
Private Sub CommandButton3_Click()
TextBox1.Text = "": ListBox1.Clear: ListBox2.Clear: ListBox3.Clear
End Sub
3. Ejercicios
'UNO
Option Explicit
'*********** INFORME DEL PROGRAMA ***********
'Ejercicios de Microsoft Office Excel 2003
'Autor: Fernando Carraro Aguirre
'Versión 1.0
'5 de julio de 2010
'--------------------------------------------
Private Sub CommandButton1_Click() 'botón Tabla dinámica
Beep
Sheets("Tabla dinámica").Activate
End Sub
Private Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift
As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.BackColor = &H8000000F
CommandButton1.ForeColor = &H80000012
CommandButton2.BackColor = &H8000000F
CommandButton2.ForeColor = &H80000012
CommandButton3.BackColor = &H8000000F
CommandButton3.ForeColor = &H80000012
End Sub
Private Sub CommandButton2_MouseDown(ByVal Button As Integer, ByVal Shift
As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.BackColor = &H8000000F
CommandButton1.ForeColor = &H80000012
CommandButton2.BackColor = &H8000000F
CommandButton2.ForeColor = &H80000012
CommandButton3.BackColor = &H8000000F
CommandButton3.ForeColor = &H80000012
End Sub
Private Sub CommandButton3_MouseDown(ByVal Button As Integer, ByVal Shift
As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.BackColor = &H8000000F
CommandButton1.ForeColor = &H80000012
CommandButton2.BackColor = &H8000000F
CommandButton2.ForeColor = &H80000012
CommandButton3.BackColor = &H8000000F
CommandButton3.ForeColor = &H80000012
End Sub
'reestablecer colores
Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.BackColor = &H8000000F
CommandButton1.ForeColor = &H80000012
CommandButton2.BackColor = &H8000000F
CommandButton2.ForeColor = &H80000012
CommandButton3.BackColor = &H8000000F
CommandButton3.ForeColor = &H80000012
End Sub
Private Sub CommandButton2_MouseUp(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.BackColor = &H8000000F
CommandButton1.ForeColor = &H80000012
CommandButton2.BackColor = &H8000000F
CommandButton2.ForeColor = &H80000012
CommandButton3.BackColor = &H8000000F
CommandButton3.ForeColor = &H80000012
End Sub
Private Sub CommandButton3_MouseUp(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.BackColor = &H8000000F
CommandButton1.ForeColor = &H80000012
CommandButton2.BackColor = &H8000000F
CommandButton2.ForeColor = &H80000012
CommandButton3.BackColor = &H8000000F
CommandButton3.ForeColor = &H80000012
End Sub
Private Sub CommandButton2_Click() 'botón Agenda
Beep
Sheets("Agenda").Activate
End Sub
Private Sub CommandButton3_Click() 'botón Promedio
Beep
Sheets("Promedio").Activate
End Sub
'colores
Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift
As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.BackColor = vbBlue
CommandButton1.ForeColor = vbWhite
CommandButton2.BackColor = &H8000000F
CommandButton2.ForeColor = &H80000012
CommandButton3.BackColor = &H8000000F
CommandButton3.ForeColor = &H80000012
End Sub
Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift
As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton2.BackColor = vbBlue
CommandButton2.ForeColor = vbWhite
CommandButton1.BackColor = &H8000000F
CommandButton1.ForeColor = &H80000012
CommandButton3.BackColor = &H8000000F
CommandButton3.ForeColor = &H80000012
End Sub
Private Sub CommandButton3_MouseMove(ByVal Button As Integer, ByVal Shift
As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton3.BackColor = vbBlue
CommandButton3.ForeColor = vbWhite
CommandButton2.BackColor = &H8000000F
CommandButton2.ForeColor = &H80000012
CommandButton1.BackColor = &H8000000F
CommandButton1.ForeColor = &H80000012
End Sub
'DOS
Option Explicit
Dim numero As Integer, suma As Integer, i As Integer
Dim nota As Double, promedio As Double
Private Sub CommandButton1_Click() 'promedio
numero = ActiveSheet.Range("b3").Value
suma = 0: i = 0
For i = 1 To numero
nota = Val(InputBox("Valor del elemento no." & i))
suma = suma + nota
Next i
promedio = suma / numero
'resultados
ActiveSheet.Range("c8").Value = suma
ActiveSheet.Range("d8").Value = promedio
End Sub
Public Sub borrar()
ActiveSheet.Range("b3").Value = Empty
ActiveSheet.Range("c8").Value = Empty
ActiveSheet.Range("d8").Value = Empty
End Sub
Private Sub CommandButton2_Click() 'borrar
Call borrar
End Sub
Private Sub CommandButton3_Click() 'menú
Beep
Sheets("Menú").Activate
End Sub
'colores
Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift
As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.BackColor = vbBlack
CommandButton1.ForeColor = vbWhite
CommandButton2.BackColor = &H8000000F
CommandButton2.ForeColor = &H80000012
CommandButton3.BackColor = &H8000000F
CommandButton3.ForeColor = &H80000012
End Sub
Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift
As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton2.BackColor = vbBlack
CommandButton2.ForeColor = vbWhite
CommandButton1.BackColor = &H8000000F
CommandButton1.ForeColor = &H80000012
CommandButton3.BackColor = &H8000000F
CommandButton3.ForeColor = &H80000012
End Sub
Private Sub CommandButton3_MouseMove(ByVal Button As Integer, ByVal Shift
As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton3.BackColor = vbBlack
CommandButton3.ForeColor = vbWhite
CommandButton2.BackColor = &H8000000F
CommandButton2.ForeColor = &H80000012
CommandButton1.BackColor = &H8000000F
CommandButton1.ForeColor = &H80000012
End Sub
'TRES
Private Sub CommandButton1_Click() 'menú
Beep
Sheets("Menú").Activate
End Sub
___________________________________________________________