Codigo de Evaluacion

Códigos
Pregunta 2: modificar el rango
Range("C1:D16").Copy
Range("F4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("C1:D16").Copy Destination:=Range("F4")
Pregunta 3:
Dim edad As Integer
edad = InputBox("¿cuál es tu edad", "") ' caja con la pregunta
If edad >= 18 Then ' si la edad es mayor
'mensaje
MsgBox "Eres mayor de edad"
Else ' caso contrario
MsgBox "Tu eres menor de edad"
End If 'condicional de cierre
Pregunta 4: modificar de acuerdo a lo solicitado
Dim edad As Integer ' Declaracion de variable
edad = InputBox("¿cuál es tu edad", "") ' caja con la pregunta
If edad >= 18 And edad <= 25 Then ' operador logico and (y)
MsgBox "Usted es una persona joven"
'caso contrario si
ElseIf edad >= 26 And edad <= 60 Then
MsgBox ("Usted es una persona adulta")
ElseIf edad >= 61 And edad <= 100 Then
MsgBox ("Usted esta en la etapa de la ancianidad")

Else
MsgBox ("Usted es un adolescente")
End If
End Sub
Pregunta 5:
BOTÓN AGREGAR_ IMAGEN

Private Sub cmdagregarimagen_Click()
insertarimagen = Application.GetOpenFilename("Imágenes jpg, *.jpg,Imágenes bmp, *.bmp",

0, _
"Selecionar imagen para registro de clientes ")
foto.Picture = LoadPicture("")
foto.Picture = LoadPicture(insertarimagen)
End Sub
BOTÓN AGREGARMODIFICAR
Dim insertarimagen As String
Private Sub cmdagregarmodificar_Click()
Dim i As Integer
If cbonombre.Text = "" Then
MsgBox "Campo nombre vacio. Ingrese un nombre", vbInformation + vbOKOnly
cbonombre.SetFocus
Exit Sub
End If
If Not (Mid(cbonombre.Text, 1, 1) Like "[a-z]" Or _
Mid(cbonombre.Text, 1, 1) Like "[A-Z]") Then ' sino contiene en su primer caracter una letra
minuscula o mayuscula no prosiga
MsgBox "Nombre invalido. Debe iniciar con letra", vbInformation + vbOKOnly
cbonombre.SetFocus
Exit Sub
End If
'mi variable va iniciar en 2
For i = 2 To Len(cbonombre.Text)
If Mid(cbonombre.Text, i, 1) Like "#" Then
MsgBox "Nombre invalido. Vuelva a escribir", vbInformation + vbOKOnly
cbonombre.SetFocus
Exit Sub
End If
Next
Sheets("clientes").Activate
Dim fcliente As Integer
fcliente = nclientes(cbonombre.Text)
If fcliente = 0 Then
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
' si el registro existe se va al final
Loop
Else
Cells(fcliente, 1).Select
End If
'en este punto agregamos o modificamos el registro
Application.ScreenUpdating = False
ActiveCell = cbonombre
ActiveCell.Offset(0, 1) = txtdireccion
ActiveCell.Offset(0, 2) = txttelefono
ActiveCell.Offset(0, 3) = txtcelular
ActiveCell.Offset(0, 4) = txtemail
ActiveCell.Offset(0, 5) = insertarimagen
Application.ScreenUpdating = True
Call limpiar
cbonombre.SetFocus
End Sub
BOTÓN ELIMINAR
Private Sub cmdeliminar_Click()
Dim fcliente As Integer
fcliente = nclientes(cbonombre.Text)
If fcliente = 0 Then
MsgBox "El cliente que ha ingresado no existe", vbCritical + vbOKOnly
cbonombre.SetFocus
Exit Sub
End If
If MsgBox("¿Seguro que desea eliminar este cliente?", vbQuestion + vbYesNo) = vbYes Then
Cells(fcliente, 1).Select
ActiveCell.EntireRow.Delete
Call limpiar
MsgBox "Cliente eliminado satisfactoriamente", vbInformation + vbOKOnly
cbonombre.SetFocus
End If
End Sub
BOTÓN SALIR
Private Sub cmdsalir_Click()
End
End Sub
MACROS ADICIONALES
MACROS LIMPIAR
Sub limpiar()
Call Cargarlista
cbonombre = ""
txtdireccion = ""
txttelefono = ""
txtcelular = ""
txtemail = ""
insertarimagen = ""
End Sub
MACROS CARGAR LISTA
Sub Cargarlista()
cbonombre.Clear
Sheets("Clientes").Select
Range("A2").Select

cbonombre.AddItem ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
End Sub
CUADRO COMBINADO
Private Sub cbonombre_Change()
On Error Resume Next
If nclientes(cbonombre.Text) <> 0 Then
Sheets("Clientes").Activate
Cells(cbonombre.ListIndex + 2, 1).Select
txtdireccion = ActiveCell.Offset(0, 1)
txttelefono = ActiveCell.Offset(0, 2)
txtcelular = ActiveCell.Offset(0, 3)
txtemail = ActiveCell.Offset(0, 4)
foto.Picture = LoadPicture(ActiveCell.Offset(0, 5))
insertarimagen = ActiveCell.Offset(0, 5)
Else
txtdireccion = ""
txttelefono = ""
txtcelular = ""
txtemail = ""
insertarimagen = ""
End If
End Sub
MODULO 1
Function nclientes(nombre As String) As Integer
Application.ScreenUpdating = False
Range("A2").Activate
nclientes = 0
If nombre = ActiveCell Then
nclientes = ActiveCell.Row
End If
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
End Function
PARA LLAMAR AL FORMULARIO DESDE EXCEL
Sub Formulariocliente()
Load clientes
clientes.Show
End Sub

Codigo de Evaluacion

Cargado por

Copyright:

Formatos disponibles

Codigo de Evaluacion

Cargado por

Información del documento

Título original

Derechos de autor

Formatos disponibles

Compartir este documento

Compartir o incrustar documentos

Opciones para compartir

¿Le pareció útil este documento?

¿Este contenido es inapropiado?

Copyright:

Formatos disponibles

Codigo de Evaluacion

Cargado por

Copyright:

Formatos disponibles

Códigos

Pregunta 2: modificar el rango

Dim edad As Integer

edad = InputBox("¿cuál es tu edad", "") ' caja con la pregunta

If edad >= 18 Then ' si la edad es mayor

MsgBox "Eres mayor de edad"

Else ' caso contrario

MsgBox "Tu eres menor de edad"

End If 'condicional de cierre

Pregunta 4: modificar de acuerdo a lo solicitado

Dim edad As Integer ' Declaracion de variable

edad = InputBox("¿cuál es tu edad", "") ' caja con la pregunta

MsgBox "Usted es una persona joven"

ElseIf edad >= 26 And edad <= 60 Then

MsgBox ("Usted es una persona adulta")

ElseIf edad >= 61 And edad <= 100 Then

MsgBox ("Usted esta en la etapa de la ancianidad")

MsgBox ("Usted es un adolescente")

BOTÓN AGREGAR_ IMAGEN

insertarimagen = Application.GetOpenFilename("Imágenes jpg, *.jpg,Imágenes bmp, *.bmp",

"Selecionar imagen para registro de clientes ")

Dim insertarimagen As String

Private Sub cmdagregarmodificar_Click()

If cbonombre.Text = "" Then

MsgBox "Campo nombre vacio. Ingrese un nombre", vbInformation + vbOKOnly

If Not (Mid(cbonombre.Text, 1, 1) Like "[a-z]" Or _

'mi variable va iniciar en 2

If Mid(cbonombre.Text, i, 1) Like "#" Then

MsgBox "Nombre invalido. Vuelva a escribir", vbInformation + vbOKOnly

Dim fcliente As Integer

Do While Not IsEmpty(ActiveCell)

' si el registro existe se va al final

'en este punto agregamos o modificamos el registro

Private Sub cmdeliminar_Click()

Dim fcliente As Integer

MsgBox "El cliente que ha ingresado no existe", vbCritical + vbOKOnly

Private Sub cmdsalir_Click()

Do While Not IsEmpty(ActiveCell)

If nclientes(cbonombre.Text) <> 0 Then

Do While Not IsEmpty(ActiveCell)

If nombre = ActiveCell Then

PARA LLAMAR AL FORMULARIO DESDE EXCEL

También podría gustarte

insertarimagen = Application.GetOpenFilename("Imágenes jpg, .jpg,Imágenes bmp, .bmp",