Mantenedor - Bitacora. Codigo Visual Basic
Para crear un mantenedor en VB con excel, el codigo sería de la siguiente forma:
1.- Ir a la pestaña VB en excel
2.- Abrir un nuevo formulario
3.- Habilitar las herramientas de diseño
4.- A través de las herramientas de diseño, podemos seleccionar multiples opciones de acuerdo a lo que necesitemos. Entre las herramientas destacadas encontramos: COMBOBOX, LABEL, TEXTBOX, COMANDBUTTON, OPTIONBUTTON, ETC.
Así es como nos queda nuestro formulario con estos elementos:
Y ahora... nada de esto nos sirve realmente si no tenemos programado el código. para el caso de este formulario, la mayor parte es programada en el Boton de comndo, que es que procesará los datos ingresados. el código como sigue:
1.a.- CÓDIGO FORMULARIO INGRESO
Private Sub CommandButton1_Click()
Sheets("Clientes").Select
If txtRut = "" Or txtNombre = "" Or txtApellido = "" Or txtDireccion = "" Or txtTelefono = "" Or txtEmail = "" Or txtMarca = "" Or txtModelo = "" Or txtProcesador = "" Or txtSello = "" Or txtMotivo = "" Or txtObs = "" Then
MsgBox ("campos vacios, debe completar")
txtRut.SetFocus
Else
Range("a2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell = txtRut
ActiveCell.Offset(0, 1).Select
ActiveCell = txtNombre
ActiveCell.Offset(0, 1).Select
ActiveCell = txtApellido
ActiveCell.Offset(0, 1).Select
ActiveCell = txtDireccion
ActiveCell.Offset(0, 1).Select
ActiveCell = txtTelefono
ActiveCell.Offset(0, 1).Select
ActiveCell = txtEmail
ActiveCell.Offset(0, 1).Select
ActiveCell = txtMarca
ActiveCell.Offset(0, 1).Select
ActiveCell = txtModelo
ActiveCell.Offset(0, 1).Select
ActiveCell = txtProcesador
ActiveCell.Offset(0, 1).Select
ActiveCell = txtSello
ActiveCell.Offset(0, 1).Select
ActiveCell = txtMotivo
ActiveCell.Offset(0, 1).Select
ActiveCell = txtObs
ActiveCell.Offset(0, 1).Select
txtRut = ""
txtNombre = ""
txtApellido = ""
txtDireccion = ""
txtTelefono = ""
txtEmail = ""
txtMarca = ""
txtModelo = ""
txtProcesador = ""
txtSello = ""
txtMotivo = ""
txtObs = ""
txtRut.SetFocus
End If
End Sub
Private Sub CommandButton2_Click()
End
End Sub
Private Sub Label2_Click()
End Sub
Private Sub Label8_Click()
End Sub
Private Sub TextBox9_Change()
End Sub
Private Sub txtrut_Change()
End Sub
Private Sub UserForm_Click()
End Sub
1.b.- CÓDIGO FORMULARIO MODIFICAR - ELIMINAR
Sub cargarnombre()
CBxNombre.Clear
Sheets("clientes").Activate
Range("b1").Select
For i = 1 To 5
If ActiveCell.Offset(1, 0).Value <> "" Then
CBxNombre.AddItem ActiveCell.Offset(i, 0).Value
End If
Next
End Sub
Sub cargarrut()
CBxRut.Clear
Sheets("clientes").Activate
Range("a1").Select
For i = 1 To 5
If ActiveCell.Offset(1, 0).Value <> "" Then
CBxRut.AddItem ActiveCell.Offset(i, 0).Value
End If
Next
End Sub
Private Sub CheckBox1_Click()
End Sub
Private Sub btnEliminar_Click()
If txtRut = "" And txtNombre = "" And txtApellido = "" And txtDireccion = "" And txtTelefono = "" And txtEmail = "" Then
MsgBox ("No existen campos para ser eliminados")
Else
YesNo = MsgBox("¿Está seguro que desea eliminar este registro?", vbYesNo + vbExclamation, "Warning")
Select Case YesNo
Case vbYes
Selection.EntireRow.Delete
Range("b2").Select
txtRut = Empty
txtNombre = Empty
txtApellido = Empty
txtDireccion = Empty
txtTelefono = Empty
txtEmail = Empty
MsgBox ("registro eliminado"), vbInformation, "Sistema"
Case vbNo
MsgBox ("Operacion Cancelada")
End Select
cargarrut
cargarnombre
End If
End Sub
Private Sub btnModificar_Click()
Sheets("Clientes").Activate
If txtRut = "" Or txtNombre = "" Or txtApellido = "" Or txtDireccion = "" Or txtTelefono = "" Or txtEmail = "" Then
MsgBox "Está dejando campos requeridos vacios favor complete", vbInformation, "Almacen"
txtNombre.SetFocus
Else
If ChBxRut.Value = True Then
ActiveCell.Offset(0, 1) = txtNombre.Value
ActiveCell.Offset(0, 2) = txtApellido.Value
ActiveCell.Offset(0, 3) = txtDireccion.Value
ActiveCell.Offset(0, 4) = txtTelefono.Value
ActiveCell.Offset(0, 5) = txtEmail.Value
MsgBox "Datos actualizados correctamente", vbInformation, "Almacen"
txtRut = ""
txtNombre = ""
txtApellido = ""
txtDireccion = ""
txtTelefono = ""
txtEmail = ""
txtNombre.Locked = True
txtApellido.Locked = True
txtDireccion.Locked = True
txtTelefono.Locked = True
txtEmail.Locked = True
Else
ActiveCell = txtNombre.Value
ActiveCell.Offset(0, 1) = txtNombre.Value
ActiveCell.Offset(0, 1) = txtApellido.Value
ActiveCell.Offset(0, 2) = txtDireccion.Value
ActiveCell.Offset(0, 3) = txtTelefono.Value
ActiveCell.Offset(0, 4) = txtEmail.Value
MsgBox "Datos actualizados correctamente", vbInformation, "Almacen"
txtRut = ""
txtNombre = ""
txtApellido = ""
txtDireccion = ""
txtTelefono = ""
txtEmail = ""
txtNombre.Locked = True
txtApellido.Locked = True
txtDireccion.Locked = True
txtTelefono.Locked = True
txtEmail.Locked = True
End If
ChBxRut.Value = False
ChBxNombre.Value = False
End If
End Sub
Private Sub btnVolver_Click()
Unload Me
FormIngresar.Show
End Sub
Private Sub CBxNombre_Change()
If CBxNombre = "" Then
Else
Sheets("Clientes").Activate
If CBxNombre = Empty Then
MsgBox "Para modificar primero seleccione proveedor", vbInformation, "Almacen"
CBxNombre.ListIndex = 0
CBxNombre.SetFocus
End If
var3 = CBxNombre.Column(0)
Cells.Find(What:=CBxNombre.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
If var3 = ActiveCell Then
txtNombre = ActiveCell
txtRut = ActiveCell.Offset(0, -1)
txtApellido = ActiveCell.Offset(0, 1)
txtDireccion = ActiveCell.Offset(0, 2)
txtTelefono = ActiveCell.Offset(0, 3)
txtEmail = ActiveCell.Offset(0, 4)
End If
End If
End Sub
Private Sub CBxRut_Change()
If CBxRut = "" Then
Else
Sheets("Clientes").Activate
If CBxRut = Empty Then
MsgBox "Para modificar primero seleccione proveedor", vbInformation, "Almacen"
CBxRut.ListIndex = 0
CBxRut.SetFocus
End If
Var2 = CBxRut.Column(0)
Cells.Find(What:=CBxRut.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
If Var2 = ActiveCell Then
txtRut = ActiveCell
txtNombre = ActiveCell.Offset(0, 1)
txtApellido = ActiveCell.Offset(0, 2)
txtDireccion = ActiveCell.Offset(0, 3)
txtTelefono = ActiveCell.Offset(0, 4)
txtEmail = ActiveCell.Offset(0, 5)
End If
End If
End Sub
Private Sub ChBxNombre_Click()
If ChBxNombre.Value = True Then
CBxNombre.Enabled = True
ChBxRut.Enabled = False
CBxRut.Enabled = False
cargarnombre
Else
CBxNombre.Enabled = False
ChBxRut.Enabled = True
CBxNombre.Clear
End If
End Sub
Private Sub ChBxRut_Click()
If ChBxRut.Value = True Then
CBxRut.Enabled = True
ChBxNombre.Enabled = False
CBxNombre.Enabled = False
cargarrut
Else
CBxRut.Enabled = False
ChBxNombre.Enabled = True
CBxRut.Clear
End If
End Sub
Private Sub UserForm_Click()
End Sub
__________________________________________________________________________________
Espero les sea de ayuda. cualquier duda dejen comentarios.
Saludos
1.- Ir a la pestaña VB en excel
2.- Abrir un nuevo formulario
3.- Habilitar las herramientas de diseño
4.- A través de las herramientas de diseño, podemos seleccionar multiples opciones de acuerdo a lo que necesitemos. Entre las herramientas destacadas encontramos: COMBOBOX, LABEL, TEXTBOX, COMANDBUTTON, OPTIONBUTTON, ETC.
Así es como nos queda nuestro formulario con estos elementos:
Y ahora... nada de esto nos sirve realmente si no tenemos programado el código. para el caso de este formulario, la mayor parte es programada en el Boton de comndo, que es que procesará los datos ingresados. el código como sigue:
1.a.- CÓDIGO FORMULARIO INGRESO
Private Sub CommandButton1_Click()
Sheets("Clientes").Select
If txtRut = "" Or txtNombre = "" Or txtApellido = "" Or txtDireccion = "" Or txtTelefono = "" Or txtEmail = "" Or txtMarca = "" Or txtModelo = "" Or txtProcesador = "" Or txtSello = "" Or txtMotivo = "" Or txtObs = "" Then
MsgBox ("campos vacios, debe completar")
txtRut.SetFocus
Else
Range("a2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell = txtRut
ActiveCell.Offset(0, 1).Select
ActiveCell = txtNombre
ActiveCell.Offset(0, 1).Select
ActiveCell = txtApellido
ActiveCell.Offset(0, 1).Select
ActiveCell = txtDireccion
ActiveCell.Offset(0, 1).Select
ActiveCell = txtTelefono
ActiveCell.Offset(0, 1).Select
ActiveCell = txtEmail
ActiveCell.Offset(0, 1).Select
ActiveCell = txtMarca
ActiveCell.Offset(0, 1).Select
ActiveCell = txtModelo
ActiveCell.Offset(0, 1).Select
ActiveCell = txtProcesador
ActiveCell.Offset(0, 1).Select
ActiveCell = txtSello
ActiveCell.Offset(0, 1).Select
ActiveCell = txtMotivo
ActiveCell.Offset(0, 1).Select
ActiveCell = txtObs
ActiveCell.Offset(0, 1).Select
txtRut = ""
txtNombre = ""
txtApellido = ""
txtDireccion = ""
txtTelefono = ""
txtEmail = ""
txtMarca = ""
txtModelo = ""
txtProcesador = ""
txtSello = ""
txtMotivo = ""
txtObs = ""
txtRut.SetFocus
End If
End Sub
Private Sub CommandButton2_Click()
End
End Sub
Private Sub Label2_Click()
End Sub
Private Sub Label8_Click()
End Sub
Private Sub TextBox9_Change()
End Sub
Private Sub txtrut_Change()
End Sub
Private Sub UserForm_Click()
End Sub
1.b.- CÓDIGO FORMULARIO MODIFICAR - ELIMINAR
Sub cargarnombre()
CBxNombre.Clear
Sheets("clientes").Activate
Range("b1").Select
For i = 1 To 5
If ActiveCell.Offset(1, 0).Value <> "" Then
CBxNombre.AddItem ActiveCell.Offset(i, 0).Value
End If
Next
End Sub
Sub cargarrut()
CBxRut.Clear
Sheets("clientes").Activate
Range("a1").Select
For i = 1 To 5
If ActiveCell.Offset(1, 0).Value <> "" Then
CBxRut.AddItem ActiveCell.Offset(i, 0).Value
End If
Next
End Sub
Private Sub CheckBox1_Click()
End Sub
Private Sub btnEliminar_Click()
If txtRut = "" And txtNombre = "" And txtApellido = "" And txtDireccion = "" And txtTelefono = "" And txtEmail = "" Then
MsgBox ("No existen campos para ser eliminados")
Else
YesNo = MsgBox("¿Está seguro que desea eliminar este registro?", vbYesNo + vbExclamation, "Warning")
Select Case YesNo
Case vbYes
Selection.EntireRow.Delete
Range("b2").Select
txtRut = Empty
txtNombre = Empty
txtApellido = Empty
txtDireccion = Empty
txtTelefono = Empty
txtEmail = Empty
MsgBox ("registro eliminado"), vbInformation, "Sistema"
Case vbNo
MsgBox ("Operacion Cancelada")
End Select
cargarrut
cargarnombre
End If
End Sub
Private Sub btnModificar_Click()
Sheets("Clientes").Activate
If txtRut = "" Or txtNombre = "" Or txtApellido = "" Or txtDireccion = "" Or txtTelefono = "" Or txtEmail = "" Then
MsgBox "Está dejando campos requeridos vacios favor complete", vbInformation, "Almacen"
txtNombre.SetFocus
Else
If ChBxRut.Value = True Then
ActiveCell.Offset(0, 1) = txtNombre.Value
ActiveCell.Offset(0, 2) = txtApellido.Value
ActiveCell.Offset(0, 3) = txtDireccion.Value
ActiveCell.Offset(0, 4) = txtTelefono.Value
ActiveCell.Offset(0, 5) = txtEmail.Value
MsgBox "Datos actualizados correctamente", vbInformation, "Almacen"
txtRut = ""
txtNombre = ""
txtApellido = ""
txtDireccion = ""
txtTelefono = ""
txtEmail = ""
txtNombre.Locked = True
txtApellido.Locked = True
txtDireccion.Locked = True
txtTelefono.Locked = True
txtEmail.Locked = True
Else
ActiveCell = txtNombre.Value
ActiveCell.Offset(0, 1) = txtNombre.Value
ActiveCell.Offset(0, 1) = txtApellido.Value
ActiveCell.Offset(0, 2) = txtDireccion.Value
ActiveCell.Offset(0, 3) = txtTelefono.Value
ActiveCell.Offset(0, 4) = txtEmail.Value
MsgBox "Datos actualizados correctamente", vbInformation, "Almacen"
txtRut = ""
txtNombre = ""
txtApellido = ""
txtDireccion = ""
txtTelefono = ""
txtEmail = ""
txtNombre.Locked = True
txtApellido.Locked = True
txtDireccion.Locked = True
txtTelefono.Locked = True
txtEmail.Locked = True
End If
ChBxRut.Value = False
ChBxNombre.Value = False
End If
End Sub
Private Sub btnVolver_Click()
Unload Me
FormIngresar.Show
End Sub
Private Sub CBxNombre_Change()
If CBxNombre = "" Then
Else
Sheets("Clientes").Activate
If CBxNombre = Empty Then
MsgBox "Para modificar primero seleccione proveedor", vbInformation, "Almacen"
CBxNombre.ListIndex = 0
CBxNombre.SetFocus
End If
var3 = CBxNombre.Column(0)
Cells.Find(What:=CBxNombre.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
If var3 = ActiveCell Then
txtNombre = ActiveCell
txtRut = ActiveCell.Offset(0, -1)
txtApellido = ActiveCell.Offset(0, 1)
txtDireccion = ActiveCell.Offset(0, 2)
txtTelefono = ActiveCell.Offset(0, 3)
txtEmail = ActiveCell.Offset(0, 4)
End If
End If
End Sub
Private Sub CBxRut_Change()
If CBxRut = "" Then
Else
Sheets("Clientes").Activate
If CBxRut = Empty Then
MsgBox "Para modificar primero seleccione proveedor", vbInformation, "Almacen"
CBxRut.ListIndex = 0
CBxRut.SetFocus
End If
Var2 = CBxRut.Column(0)
Cells.Find(What:=CBxRut.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
If Var2 = ActiveCell Then
txtRut = ActiveCell
txtNombre = ActiveCell.Offset(0, 1)
txtApellido = ActiveCell.Offset(0, 2)
txtDireccion = ActiveCell.Offset(0, 3)
txtTelefono = ActiveCell.Offset(0, 4)
txtEmail = ActiveCell.Offset(0, 5)
End If
End If
End Sub
Private Sub ChBxNombre_Click()
If ChBxNombre.Value = True Then
CBxNombre.Enabled = True
ChBxRut.Enabled = False
CBxRut.Enabled = False
cargarnombre
Else
CBxNombre.Enabled = False
ChBxRut.Enabled = True
CBxNombre.Clear
End If
End Sub
Private Sub ChBxRut_Click()
If ChBxRut.Value = True Then
CBxRut.Enabled = True
ChBxNombre.Enabled = False
CBxNombre.Enabled = False
cargarrut
Else
CBxRut.Enabled = False
ChBxNombre.Enabled = True
CBxRut.Clear
End If
End Sub
Private Sub UserForm_Click()
End Sub
__________________________________________________________________________________
Espero les sea de ayuda. cualquier duda dejen comentarios.
Saludos
0 comentarios: