UNIDAD III

Menú Chido

Private Sub ABSTRACTOS_Click()
dATOSaBSTRACTOS.Show 1
End Sub
Private Sub araña_Click()
arregloypromedio.Show 1
End Sub
Private Sub BIENVENIDO_Click()
Bienvenido_a_VB.Show 1
End Sub
Private Sub BURBUJA_Click()
burbujamaymenyprom.Show 1
End Sub
Private Sub CALENDARIOx_Click()
calendario.Show 1
End Sub
Private Sub CAPTURENUM_Click()
captura.Show 1
End Sub
Private Sub CHICUADRADA_Click()
NUMCUACUB.Show 1
End Sub
Private Sub CHIQUITO_Click()
investmenu.Show 1
End Sub
Private Sub CONTADITOS_Click()
meses.Show 1
End Sub
Private Sub DATABASE_Click()
registraalumnos.Show 1
End Sub
Private Sub DEPRA_Click()
tienda.Show 1
End Sub
Private Sub DESPLEGA_Click()
desplegadatos.Show 1
End Sub
Private Sub DÍAS_Click()
diasvividos.Show 1
End Sub
Private Sub INCREMENTO_Click()
clickraton.Show 1
End Sub
Private Sub Label1_Click()
Label1 = Date
End Sub
Private Sub LISTA_Click()
listas.Show 1
End Sub
Private Sub METODO_Click()
metodo_de_seleccion.Show 1
End Sub
Private Sub MINaMAY_Click()
MinusAmAYU.Show 1
End Sub
Private Sub MINUTOS_Click()
hora.Show 1
End Sub
Private Sub MN_Click()
mariquita.Show 1
End Sub
Private Sub Panfila_Click()
Calculadora.Show 1
End Sub
Private Sub PAT_Click()
factoring.Show 1
End Sub
Private Sub SEGUIR_Click()
ulam.Show 1
End Sub
Private Sub SUMA_Click()
velos.Show 1
End Sub
Private Sub Timer1_Timer()
Label2.Caption = Time
End Sub
Private Sub web_Click()
arreglo.Show 1
End Sub

Base de Datos "Registar Alumnos"

Global db As Database
Global tabla As Recordset
Private Sub Command1_Click()
tabla.AddNew
tabla!NOMBRE = UCase(Text1)
tabla!SEMESTRE = Combo2
tabla!GRUPO = Combo3
tabla!MATERIA = Combo4
tabla!CALIFICACION = UCase(Text2)
tabla!CARRERA = Combo1
tabla.Update
MsgBox "REGISTRADO"
limpia
Beep
End Sub
Private Sub Form_Load()
Set db = OpenDatabase("G:\REGISTROALUMNOS\base de datos.mdb")
Set tabla = db.OpenRecordset("ALUMNOS")
End Sub
Sub limpia()
Text1 = ""
Text2 = ""
Combo1 = ""
Combo2 = ""
Combo3 = ""
Combo4 = ""
End Sub

UNIDAD II

La tiendita

Private Sub Cmdeliminar_Click()
Dim eliminar As Integer
a = MsgBox("eliminar el registro", vbYesNo, "ventas")
If a = 6 Then
eliminar = Right(List1, 14)
Txtotal = Str(Val(Txtotal) - Val(eliminar))
Txtotal = Format(Txtotal, "###.00")
Else
Exit Sub
End If
List1.RemoveItem List1.ListIndex
End Sub
Private Sub cmdpagar_Click()
Dim cambio As Integer
cambio = InputBox("capture el pago", "ventas", 0)
cambio = cambio - Val(Txtotal)
MsgBox cambio
MsgBox Format(cambio, "###.00"), vbinformatio
End Sub
Private Sub Command1_Click()
If Comproducto = "pastel 3 leches" Then
Txtunitario.Text = Str(50)
Txtunitario = Format(Txtunitario, "###.00")
List1.AddItem (Comproducto) + Space(15) + (Txtunitario)
End If
If Comproducto = "gelatina italiana" Then
Txtunitario.Text = Str(120)
Txtunitario = Format(Txtunitario, "###.00")
List1.AddItem (Comproducto) + Space(15) + (Txtunitario)
End If
If Comproducto = "flan" Then
Txtunitario.Text = Str(350)
Txtunitario = Format(Txtunitario, "###.00")
List1.AddItem (Comproducto) + Space(15) + (Txtunitario)
End If
If Comproducto = "pay de fresa" Then
Txtunitario.Text = Str(50)
Txtunitario = Format(Txtunitario, "###.00")
List1.AddItem (Comproducto) + Space(15) + (Txtunitario)
End If
If Comproducto = "guayaveras" Then
Txtunitario.Text = Str(650)
Txtunitario = Format(Txtunitario, "###.00")
List1.AddItem (Comproducto) + Space(15) + (Txtunitario)
End If
Txtotal = Str(Val(Txtotal)) + Val(Txtunitario)
End Sub
Private Sub Form_Load()
Comproducto.AddItem "pastel 3 leches"
Comproducto.AddItem "gelatina italiana"
Comproducto.AddItem "flan"
Comproducto.AddItem "pay de fresa"
Comproducto.AddItem "guayaveras"
End Sub

Serie Ulam

Dim resultado, NUMERO As Integer
Private Sub Command1_Click()
NUMERO = InputBox("dame el numero a generar", "captura el numero", 0)
resultado = NUMERO Mod 2
Do While NUMERO = 1
If resultado = 0 Then
NUMERO = NUMERO / 2
Else
NUMERO = (NUMERO * 3) + 1
End If
List1.AddItem Str(NUMERO)
resultado = NUMERO Mod 2
Loop
End Sub

Click del ratón

Dim i As Integer
Private Sub cmdboton_Click()
i = i + 1
MsgBox i
End Sub

Meses

Private Sub Cmd_mes_Click()
Dim mes As Integer
mes = InputBox("CAPTURE EL MES", "MESES", 0)
Select Case mes
Case 1, 3, 5, 7, 8, 10, 12: MsgBox "EL MES TIENE 31 DIAS", vbInformation
Case 2: MsgBox "EL MES TIENE 28 DIAS", vbInformation
Case 4, 6, 9, 11: MsgBox "EL MES TIENE 30 DIAS", vbInformation
Case Else: MsgBox "NO EXISTE ESTE VALOR", vbCritical
End Select
End Sub

Número, Cuadrado y Cubo

Private Sub Command1_Click()
Dim num, i As Integer
Dim item As String
numero = InputBox("captura el numero", "pendejo", 0)
For i = 1 To numero
item = Str(i) + Space(15) + Str((1 * 1) * i * i) + Space(15) + Str((1 * 1) * i * i * i)
List1.AddItem item
Next i
End Sub

Factorial

Private Sub cmdfac_Click()
Dim i As Long
Dim factorial As Long
Dim item As String
factorial = 1
For i = 1 To Val(txtnum)
item = item + " " + Str(i) + "*"
factorial = factorial * i
Next i
item = item + "=" + Str(factorial)
List1.AddItem item
End Sub

Ordenación Método Burbuja (May, Men, y Prom.)

Dim arreglo(99) As Integer
Dim I As Integer
Dim J As Integer
Dim x(1 To 10) As Double
Dim c As Integer
Dim vectemp As Double
Private Sub Command1_Click()
For I = 0 To 99
arreglo(I) = CInt(Rnd(100) * 100)
List1.AddItem arreglo(I)
Next I
End Sub
Private Sub Command2_Click()
List1.Clear
For I = 0 To 99 Step 1
List1.AddItem arreglo(99 - I)
Next I
End Sub
Private Sub Command3_Click()
List2.Clear
For I = 0 To 99
List2.AddItem arreglo(I)
Next I
End Sub
Private Sub Command4_Click()
Dim iMin As Long
Dim iMax As Long
Dim vectemp As Long
Dim pos As Long
iMin = LBound(arreglo)
iMax = UBound(arreglo)
While iMax > iMin
pos = iMin
For I = iMin To iMax - 1
If arreglo(I) > arreglo(I + 1) Then
vectemp = arreglo(I + 1)
arreglo(I + 1) = arreglo(I)
arreglo(I) = vectemp
pos = I
End If
Next I
iMax = pos
Wend
List2.Clear
For I = 0 To 99
List2.AddItem arreglo(I)
Next I
End Sub
Private Sub Command5_Click()
Dim menor, mayor As Integer
menor = LBound(arreglo)
mayor = UBound(arreglo)
Text1 = arreglo(mayor)
Text2 = arreglo(menor)
For I = menor To mayor
promedio = promedio + arreglo(I)
Next I
promedio = promedio / (mayor + I)
Text3 = Str(promedio)
End Sub

Ejemplo de menú chiquito

Private Sub CINCO_Click()
MsgBox ("LAURA YADIRA ROMO GONZÁLEZ")
End Sub
Private Sub DOS_Click()
UCase (Text1)
Text2 = UCase(Text1)
Text1.SetFocus
End Sub
Private Sub SEIS_Click()
Unload Me
End
End Sub
Private Sub TRES_Click()
UCase (Text1)
Text2 = UCase(Text1)
End Sub

Convertir números a letras

Private Sub Command1_Click()
Dim Vic As String
Vic = Right(CStr(Format(Text1.Text, "$#,##0.#0;($#,##0)")), 2)
Text2.Text = " (" & Num2Text(Val(Text1.Text)) & " PESOS " & Vic & " /100 " & " MN ) "
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text1.SetFocus
End Sub
Private Sub Command3_Click()
Unload Me
End
End Sub

MÓDULO

Public Function Num2Text(ByVal value As Double) As String
Select Case value
Case 0: Num2Text = "CERO"
Case 1: Num2Text = "UN"
Case 2: Num2Text = "DOS"
Case 3: Num2Text = "TRES"
Case 4: Num2Text = "CUATRO"
Case 5: Num2Text = "CINCO"
Case 6: Num2Text = "SEIS"
Case 7: Num2Text = "SIETE"
Case 8: Num2Text = "OCHO"
Case 9: Num2Text = "NUEVE"
Case 10: Num2Text = "DIEZ"
Case 11: Num2Text = "ONCE"
Case 12: Num2Text = "DOCE"
Case 13: Num2Text = "TRECE"
Case 14: Num2Text = "CATORCE"
Case 15: Num2Text = "QUINCE"
Case Is < 20: Num2Text = "DIECI" & Num2Text(value - 10)
Case 20: Num2Text = "VEINTE"

Case Is < 30: Num2Text = "VEINTI" & Num2Text(value - 20)
Case 30: Num2Text = "TREINTA"
Case 40: Num2Text = "CUARENTA"
Case 50: Num2Text = "CINCUENTA"
Case 60: Num2Text = "SESENTA"
Case 70: Num2Text = "SETENTA"
Case 80: Num2Text = "OCHENTA"
Case 90: Num2Text = "NOVENTA"
Case Is < 100: Num2Text = Num2Text(Int(value \ 10) * 10) & " Y " & Num2Text(value Mod 10)

Case 100: Num2Text = "CIEN"
Case Is < 200: Num2Text = "CIENTO " & Num2Text(value - 100)
Case 200, 300, 400, 600, 800: Num2Text = Num2Text(Int(value \ 100)) & "CIENTOS"
Case 500: Num2Text = "QUINIENTOS"
Case 700: Num2Text = "SETECIENTOS"
Case 900: Num2Text = "NOVECIENTOS"
Case Is < 1000: Num2Text = Num2Text(Int(value \ 100) * 100) & " " & Num2Text(value Mod 100)
Case 1000: Num2Text = "MIL"
Case Is < 2000: Num2Text = "MIL " & Num2Text(value Mod 1000)
Case Is < 1000000: Num2Text = Num2Text(Int(value \ 1000)) & " MIL"
If value Mod 1000 Then Num2Text = Num2Text & " " & Num2Text(value Mod 1000)
Case 1000000: Num2Text = "UN MILLON"
Case Is < 2000000: Num2Text = "UN MILLON " & Num2Text(value Mod 1000000)
Case Is < 1000000000000#: Num2Text = Num2Text(Int(value / 1000000)) & " MILLONES "
If (value - Int(value / 1000000) * 1000000) Then Num2Text = Num2Text & " " & Num2Text(value - Int(value / 1000000) * 1000000)
Case 1000000000000#: Num2Text = "UN BILLON"
Case Is < 2000000000000#: Num2Text = "UN BILLON " & Num2Text(value - Int(value / 1000000000000#) * 1000000000000#)
Case Else: Num2Text = Num2Text(Int(value / 1000000000000#)) & " BILLONES"
If (value - Int(value / 1000000000000#) * 1000000000000#) Then Num2Text = Num2Text & " " & Num2Text(value - Int(value / 1000000000000#) * 1000000000000#)
End Select
End Function

Agenda

Private Sub cmdguardar_Click()
registro.AddNew
registro!Evento = UCase(txtevento)
registro!Hora = UCase(txthora)
registro!Fecha = UCase(txtfecha)
registro!Contacto = UCase(txtcontacto)
registro.Update
MsgBox "Registrado Jefa"
Beep
End Sub

Private Sub cmdlimpiar_Click()
txtevento = ""
txthora = ""
txtfecha = ""
txtcontacto = ""
End Sub

Private Sub Form_Load()
Set ag = OpenDatabase("e:\agenda2\bitacora.mdb")
Set registro = ag.OpenRecordset("bitacora")
End Sub

UNIDAD I

Convertir texto a binario

Convertir grados

Private Sub Command1_Click()
cent = (9 / 5) * (Text1)
po = cent + 32
Label3 = po
Text1 = ""
Text1.SetFocus
End Sub

Private Sub Command2_Click()
End
End Sub

Agrega a Lista

Private Sub botón_Click()

Text1.SetFocus

List1.AddItem (Text1)

Text1 = ""

End Sub

Timer

Private Sub Timer1_Timer()
Label2 = Time
End Sub

Ascendente y Descendente

Dim arreglo(99) As Integer
Dim I As Integer
Private Sub Command1_Click()
For I = 0 To 99
arreglo(I) = CInt(Rnd(100) * 100)
List1.AddItem arreglo(I)
Next I
End Sub
Private Sub Command2_Click()
List1.Clear
For I = 0 To 99 Step 1
List1.AddItem arreglo(99 - I)
Next I
End Sub
Private Sub Command3_Click()
List1.Clear
For I = 0 To 99
List1.AddItem arreglo(I)
Next I
End Sub

DÍA_Mes_Año...Progresivamente

Private Sub HScroll1_Change()

Label1.Caption = HScroll1

End Sub
Private Sub HScroll2_Change()

Label2.Caption = HScroll2

End Sub
Private Sub HScroll3_Change()

Label3.Caption = HScroll3

End Sub

Desplega Datos

Private Sub Command1_Click()
Text1.SetFocus
Combo1.AddItem (Text1)
Text1 = ""
End Sub

Días vividos

Private Sub Calendar1_Click()
Text2.Text = Calendar1
Text3 = Str(CDate(Label1) - CDate(Text2))
End Sub
Private Sub Command1_Click()
Dim item As String
item = UCase(Text1) + Space(5) + Label1 + Space(5) + Str(Calendar1) + Space(5) + Text3
List1.AddItem item
Text1 = ""
Text2 = ""
Text3 = ""
End Sub
Private Sub Form_Load()
Label1.Caption = Date
End Sub

Día/Mes/Año

Private Sub Calendar1_Click()
MsgBox Calendar1
End Sub

Arreglo & Promedio

Dim arreglo(9) As Integer
Dim i As Integer
Dim promedio As Single
Private Sub Command1_Click()
i = 0
promedio = 0
Text1 = ""
Text2 = ""
Text3 = ""
End Sub
Private Sub Command2_Click()
End
End Sub

Escriba un Número Entero

Private Sub Command1_Click()
Dim a As Integer
a = InputBox("escriba un numero entero", 0)
End Sub

Datos abstractos

Private Sub Command1_Click()
MsgBox ("Tipos de datos abstractos")
End Sub

Convertir Minúsculas a Mayúsculas

Private Sub Command1_Click()
UCase (Text1)
Text2 = UCase(Text1)
Text1.SetFocus
End Sub
Private Sub Command2_Click()
Text1.SetFocus
Text1 = ""
Text2 = ""
End Sub

Calculadora

Dim bsuma, bresta, bmulti, bdivicion As Boolean
Dim divicion As Single
Dim suma, resta, multi, resultado As Integer
Private Sub command1_click()
Text1 = Text1 + Str(1)
End Sub
Private Sub Command10_Click()
Text1 = Text1 + Str(0)
End Sub
Private Sub Command11_Click()
suma = Val(Text1)Text1 = ""
bsuma = True
End Sub

Private Sub Command12_Click()
resta = Val(Text1)Text1 = ""
bresta = True
End Sub

Private Sub Command13_Click()
multi = Val(Text1)Text1 = ""
bmulti = True
End Sub

Private Sub command15_click()
If bsuma = True Then
resultado = resultado + Val(Text1)
suma = suma + Val(Text1)
Text1 = Str(suma)
bsuma = False
End If
If bresta = True Then
resultado = resultado + Val(Text1)
resta = resta - Val(Text1)
Text1 = Str(resta)
bresta = False
End If
If bmulti = True Then
resultado = resultado + Val(Text1)
multi = multi * Val(Text1)
Text1 = Str(multi)
bmulti = False
End If
If bdivicion = True Then
resultado = resultado + Val(Text1)
divicion = divicion / Val(Text1)
Text1 = Str(divicion)
bdivicion = False
End If
End Sub

Private Sub Command16_Click()
Text1 = 0
suma = 0
resta = 0
multi = 0
divicion = 0
End Sub



Private Sub Command2_Click()
Text1 = Text1 + Str(2)
End Sub
Private Sub Command3_Click()
Text1 = Text1 + Str(3)
End Sub
Private Sub Command4_Click()
Text1 = Text1 + Str(4)
End Sub
Private Sub Command5_Click()
Text1 = Text1 + Str(5)End Sub
Private Sub Command6_Click()
Text1 = Text1 + Str(6)
End Sub
Private Sub Command7_Click()
Text1 = Text1 + Str(7)
End Sub
Private Sub Command8_Click()
Text1 = Text1 + Str(8)
End Sub
Private Sub Command9_Click()
Text1 = Text1 + Str(9)
End Sub
Private Sub command14_click()
divicion = Val(Text1)
Text1 = ""
bdivicion = True
End Sub

¡¡¡Bienvenido a Visual Basic!!!

Private Sub Command1_Click()
MsgBox ("¡¡¡ Bienvenido a Visual Basic !!!")
End Sub

Suma

Private Sub Command1_Click()
Dim a, b As Integera
a= InputBox("escriba el valor de a:", 0)
b = InputBox("escriba el valor de b:", 0)
MsgBox (a + b)
End Sub