Macro de Userform Para Buscar y reemplazar datos dentro de un Formulario y base de datos
Necesito programar un boton de busqueda para buscar Los datos ver si existen previos y modificarlos en el formulario, Y Que al cambiarlos se Pueda Cambiar en la base de datos.
Private Sub CheckBox1_Click()
'Formula para selccionar rango de edad mayor de 18
Range("D2").Select
If CheckBox1 Then
edad = "'" & "+18"
ActiveCell.FormulaR1C1 = edad
Else
If CheckBox2 = "" And CheckBox1 = "" Then
ActiveCell.FormulaR1C1 = ""
MsgBox "Seleccione Un Rango de Edad"
End If
End If
End Sub
Private Sub CheckBox2_Click()
Range("D2").Select
'Formula para Seleccionar rango de edad menor de 18
If CheckBox2 Then
edad = "'" & "-18"
ActiveCell.FormulaR1C1 = edad
Else
If CheckBox1 = "" And CheckBox2 = "" Then
ActiveCell.FormulaR1C1 = ""
MsgBox "Seleccione Un Rango de Edad"
End If
End If
End Sub
Private Sub ComboBox1_Change()
'Selecciona Localizacion o Donde Vive
Range("E2").Select
ActiveCell.FormulaR1C1 = ComboBox1.Value
End Sub
Private Sub CommandButton1_Click()
'Boton de Guardar/Aceptar
'Captura los datos del formulario y los pasa a la base de datos de excel
If CheckBox1 = True And CheckBox2 = True Then
MsgBox "solo puede elegir una opción"
CheckBox1 = False
CheckBox2 = False
Exit Sub
Else
If CheckBox1 = False And CheckBox2 = False Then
MsgBox "Elige una edad"
CheckBox1 = False
CheckBox2 = False
Exit Sub
Else
If ComboBox1.Value = 0 Or ComboBox1.Value = "" Then
MsgBox "Elija Su Provincia"
ComboBox1 = ""
Exit Sub
Else
If ListBox1.Text = "" Then
MsgBox "Seleccione Su Tipo De Sangre"
ListBox1 = ""
Exit Sub
End If
End If
End If
End If
Selection.EntireRow.Insert
TextBox1 = Empty
TextBox2 = Empty
TextBox1.SetFocus
CheckBox1 = 0
CheckBox2 = 0
OptionButton1 = False
OptionButton2 = False
ComboBox1 = ""
ListBox1 = ""
End Sub
Private Sub CommandButton2_Click()
'Boton para Cerrar el Formulario
Unload Me
End Sub
Private Sub CommandButton3_Click()
'Boton para limpiar todos los datos
TextBox1 = Empty
TextBox2 = Empty
TextBox1.SetFocus
CheckBox1 = 0
CheckBox2 = 0
OptionButton1 = False
OptionButton2 = False
ComboBox1 = ""
ListBox1 = ""
End Sub
Private Sub CommandButton4_Click()
'Aqui Va El Codigo del boton buscar
'De ser Necesario puedo ingresar un boton Cambiar y conservar Este como Boton Buscar
End Sub
Private Sub ListBox1_Click()
'La lista de tipos de sangre
Range("F2").Select
ActiveCell.FormulaR1C1 = ListBox1.Text
End Sub
Private Sub OptionButton1_Click()
'Opcion para seleccionar Sexo Hombre
If OptionButton1.Value = True Then
Range("C2").Select
ActiveCell.Value = OptionButton1.Caption
End If
If OptionButton1.Value = False Then
MsgBox "Seleccione Una Casilla"
Else
If OptionButton1.Value = False And OptionButton2.Value = False And Len(TextBox1.Text) = 0 Then
MsgBox "Seleccione Una Casilla"
End If
End If
End Sub
Private Sub OptionButton2_Click()
'Opcion Para elegir Sexo mujer
If OptionButton2.Value = True Then
Range("C2").Select
ActiveCell.Value = OptionButton2.Caption
End If
If OptionButton2.Value = False Then
MsgBox "Seleccione Una Casilla"
Else
If OptionButton2.Value = False And OptionButton1.Value = False And Len(TextBox1.Text) = 0 Then
MsgBox "Seleccione Una Casilla"
End If
End If
End Sub
Private Sub TextBox1_Change()
'Nombre
Range("A2").Select
ActiveCell.FormulaR1C1 = TextBox1
End Sub
Private Sub TextBox2_Change()
'Apellido
Range("B2").Select
ActiveCell.FormulaR1C1 = TextBox2
End Sub
Private Sub UserForm_Activate()
'Tipo de Sangre
ListBox1.AddItem ""
End Sub
Private Sub UserForm_Initialize()
'Estas Son Las localidades
ComboBox1.AddItem ""
End SubCualquier ayuda seria muy agradecida.
2 Respuestas
[Hola
Te envié el archivo
Macro con los nuevos ajustes.
Valora la respuesta para finalizar saludos!
Private Sub CommandButton1_Click()
'
'**Por Adriel Ortiz
'
Set h = Sheets("Hoja1")
If CheckBox1 = True And CheckBox2 = True Then
MsgBox "solo puede elegir una opción"
CheckBox1 = False
CheckBox2 = False
Exit Sub
End If
If CheckBox1 = False And CheckBox2 = False Then
MsgBox "Elige una edad"
CheckBox1 = False
CheckBox2 = False
Exit Sub
End If
If ComboBox1.Value = 0 Or ComboBox1.Value = "" Then
MsgBox "Elija Su Provincia"
ComboBox1 = ""
Exit Sub
End If
If ListBox1.ListIndex = -1 Then
MsgBox "Seleccione Su Tipo De Sangre"
Exit Sub
End If
'
uf = h.Range("A" & Rows.Count).End(xlUp).Row
u = h.Range("A" & Rows.Count).End(xlUp).Row + 1
'
num = h.Cells(uf, "A")
If num = "" Then
TextBox1 = 1
Else
TextBox1 = num + 1
End If
h.Cells(u, "A") = Val(TextBox1)
'
h.Cells(u, "B") = TextBox2
h.Cells(u, "C") = TextBox3
'
If OptionButton1 Then
sexo = "Hombre"
End If
'
If OptionButton2 Then
sexo = "Mujer"
End If
h.Cells(u, "D") = sexo
'**********************************
If CheckBox1 Then
edad = "'" & "+18"
End If
'
If CheckBox1 Then
edad = "'" & "-18"
End If
h.Cells(u, "E") = edad
'
h.Cells(u, "F") = ComboBox1
h.Cells(u, "G") = ListBox1.List(ListBox1.ListIndex, 0)
Call limpiar
End Sub
'
Private Sub CommandButton2_Click()
Unload Me
End Sub
'
Private Sub CommandButton3_Click()
TextBox1 = Empty
TextBox2 = Empty
TextBox1.SetFocus
CheckBox1 = 0
CheckBox2 = 0
OptionButton1 = False
OptionButton2 = False
ComboBox1 = ""
ListBox1 = ""
End Sub
'
Private Sub CommandButton4_Click()
'Aqui Va El Codigo del boton buscar
'De ser Necesario puedo ingresar un boton Cambiar y conservar Este como Boton Buscar
Set h5 = Sheets("Hoja1")
If Txtbuscar.Text <> "" Then
Txtbuscar.Text = UCase(Txtbuscar.Text)
ListBox2.Clear
For i = 2 To h5.Range("A" & Rows.Count).End(xlUp).Row
cad = h5.Cells(i, "B") & UCase(h5.Cells(i, "B"))
If cad Like "*" & UCase(Txtbuscar) & "*" Then
With ListBox2
. AddItem h5.Cells(i, "A")
. List(.ListCount - 1, 1) = h5.Cells(i, "B")
. List(.ListCount - 1, 2) = h5.Cells(i, "C")
. List(.ListCount - 1, 3) = h5.Cells(i, "D")
. List(.ListCount - 1, 4) = h5.Cells(i, "E")
. List(.ListCount - 1, 5) = h5.Cells(i, "F")
. List(.ListCount - 1, 6) = h5.Cells(i, "G")
End With
End If
Next
Else
Txtbuscar.SetFocus
End If
End Sub
'
Private Sub CommandButton5_Click()
Set h1 = Sheets("Hoja1")
'
If ListBox2.ListIndex = -1 Then
MsgBox "Debe seleccionar un registro"
Exit Sub
End If
'
cod = ListBox2.List(ListBox2.ListIndex, 0)
Set r = h1.Columns("A")
Set b = r.Find(cod, lookat:=xlWhole)
If Not b Is Nothing Then
h1.Cells(b.Row, "B") = TextBox2
h1.Cells(b.Row, "C") = TextBox3
'
If OptionButton1 Then
sexo = "Hombre"
End If
'
If OptionButton2 Then
sexo = "Mujer"
End If
h1.Cells(b.Row, "D") = sexo
'**********************************
If CheckBox1 Then
edad = "'" & "+18"
End If
'
If CheckBox1 Then
edad = "'" & "-18"
End If
h1.Cells(b.Row, "E") = edad
'
h1.Cells(b.Row, "F") = ComboBox1
h1.Cells(b.Row, "G") = ListBox1.List(ListBox1.ListIndex, 0)
End If
MsgBox "Datos Actualizados con éxito"
Txtbuscar = ""
ListBox2.Clear
Call limpiar
End Sub
'
Private Sub ListBox2_Click()
TextBox1 = ListBox2.List(ListBox2.ListIndex, 0)
TextBox2 = ListBox2.List(ListBox2.ListIndex, 1)
TextBox3 = ListBox2.List(ListBox2.ListIndex, 2)
sexo = ListBox2.List(ListBox2.ListIndex, 3)
If sexo = "Hombre" Then
OptionButton1 = True
Else
OptionButton1 = False
End If
'
If sexo = "Mujer" Then
OptionButton2 = True
Else
OptionButton2 = False
End If
'
dato = ListBox2.List(ListBox2.ListIndex, 4)
If dato = "+18" Then
CheckBox1 = True
Else
CheckBox1 = False
End If
'
If dato = "-18" Then
CheckBox2 = True
Else
CheckBox2 = False
End If
ComboBox1 = ListBox2.List(ListBox2.ListIndex, 5)
ListBox1 = ListBox2.List(ListBox2.ListIndex, 6)
End Sub
'
Sub limpiar()
TextBox1 = Empty
TextBox2 = Empty
TextBox3 = Empty
TextBox2.SetFocus
CheckBox1 = 0
CheckBox2 = 0
OptionButton1 = False
OptionButton2 = False
ComboBox1 = ""
ListBox1 = ""
End Sub
'
Private Sub UserForm_Activate()
ListBox1.AddItem ""
ListBox1.AddItem "O+"
ListBox1.AddItem "O-"
ListBox1.AddItem "A+"
ListBox1.AddItem "A-"
ListBox1.AddItem "B+"
ListBox1.AddItem "B-"
ListBox1.AddItem "AB+"
ListBox1.AddItem "AB-"
End Sub
'
Private Sub UserForm_Initialize()
ComboBox1. AddItem ""
ComboBox1. AddItem "Bocas Del Toro"
ComboBox1. AddItem "Cocle"
ComboBox1. AddItem "Colon"
ComboBox1. AddItem "Chiriqui"
ComboBox1. AddItem "Darien"
ComboBox1. AddItem "Herrera"
ComboBox1. AddItem "Los santos"
ComboBox1. AddItem "Panama"
ComboBox1. AddItem "Veraguas"
End Sub
Lo que dices que necesitas, yo lo he hecho muchas veces, pero sabes, que esto es como los partidos de futbol, cada uno es distinto. Tal y como te dice Adriel, si me envías el archivo creo que te podría ayudar y me explicas bien la necesidad. Por ejemplo no entiendo bien lo que dices de ver si existen previos. No sé si con eso último lo que quieres decir es validar que no se dupliquen datos. Esto se puede controlar desde la entrada. Si quieres me envías el archivo y con gusto trataré de ayudarte. Mi correo, [email protected] buen día.
Ya Te envíe un correo. Desde protonmail
Por correo te estoy enviando el archivo con los procedimiendos adicionales que se requerían. Espero haberte podido ayudar. Yo lo probé y todo me funciona como lo habías solicitado. Voy a colocar aquí mis recomendaciones y el código, por si a otra persona le puede servir.
-Cuando colocas el botón para buscar y reemplazar, no se puede hacer en un sólo botón, adicionalmente tienes que destinar una caja para que el usuario pueda ingresar lo que se va a buscar.
-Es muy recomendable nombrar los objetos. Es decir, en vez de combotext1 colocar por ejemplo Nombre y en vez de combotext2 colocar Apellido. Y así todos los demás objetos. Esto facilita el seguimiento y el control.
-Para estructurar la búsqueda se requieren nociones de programación que seguro irás adquiriendo con la práctica. Por ejemplo coloco un SW (switche) para controlar si estoy ingresando un dato nuevo o si estoy es consultando. Por esta razón es que tu opción de guardar, que en tu ejercicio la llamas CommandButton1_Click() (por eso es recomendable dar nombres fáciles de ubicar), yo la divido en dos opciones, una para cuando es nuevo y otra para cuando es consulta.
-Esto también porque al nombre nuevo hay que validar que no esté repetido(según tu solicitud) y el buscado no, porque ya está. Aunque también podría ser que se cambie el nombre y podría tener que validarse. Eso ya tu lo consideras y ajustas.
-En la opción buscar, le coloco la opción de validar y buscar, si lo digitado es nombre o apellido, ahí debes revisar para que aprendas cómo se manejan las variables de columna según el caso, por eso coloco dos opciones de traer los datos, una cuando lo que se digitó es el nombre y otra para apellido.
-En la búsqueda también incluí un control de error para que aprendas a manejar cómo se controlan los errores de búsqueda.
-Incluyo una opción de regrabar que es para cuando se va a guardar la información consultada y modificada
-Incluyo la opción valida, para verificar que no hayan duplicados. Tiene if anidado porque estamos validando tanto nombre como apellidos.
-Incluí por último una rutina para que cuando se cierre el formulario y no se haga nada con la consulta, borre lo que se estaba consultando. Aquí se pueden hacer muchas cosas según lo que se quiera, para controlar el cierre dando click en la X cuando el usuario lo haga.
Ya lo que queda es le hagas los ajustes según tu necesidad o gusto.
Estas son las macros nuevas
Private Sub CommandButton1_Click()
If sw = 0 Then
grabado
Else
grabado
regrabar
End If
End Sub
Sub grabado()
If sw = 0 Then
VALIDA
End If
If CheckBox1 = True And CheckBox2 = True Then
MsgBox "solo puede elegir una opción"
CheckBox1 = False
CheckBox2 = False
Exit Sub
Else
If CheckBox1 = False And CheckBox2 = False Then
MsgBox "Elige una edad"
CheckBox1 = False
CheckBox2 = False
Exit Sub
Else
If ComboBox1.Value = 0 Or ComboBox1.Value = "" Then
MsgBox "Elija Su Provincia"
ComboBox1 = ""
Exit Sub
Else
If ListBox1.Text = "" Then
MsgBox "Seleccione Su Tipo De Sangre"
ListBox1 = ""
Exit Sub
End If
End If
End If
End If
Selection.EntireRow.Insert
TextBox1 = Empty
TextBox2 = Empty
TextBox1.SetFocus
CheckBox1 = 0
CheckBox2 = 0
OptionButton1 = False
OptionButton2 = False
ComboBox1 = ""
ListBox1 = ""
End Sub
Private Sub BUSCAR_Click()
BORRA_CAMPOS
sw = 1
Sheets("Hoja1").Select
Range("a2").Select
If BUSCADO <> "" Then
On Error GoTo ControldeError
Cells.Find(What:=BUSCADO, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
COL = ActiveCell.Column
If COL = 1 Then
TRAER_DATOS1
Else
If COL = 2 Then
TRAER_DATOS2
End If
End If
Exit Sub
ControldeError:
If Err.Number = 91 Then
MsgBox ("La información ingresada no figura registrada en la base de datos, por favor verifique lo digitado")
BUSCADO = Empty
BORRA_CAMPOS
End If
End If
End Sub
Private Sub TRAER_DATOS1()
fila = ActiveCell.Row
COL = ActiveCell.Column
TextBox1 = Cells(fila, COL)
TextBox2 = Cells(fila, COL + 1)
If Cells(fila, COL + 3) = 18 Then
CheckBox1 = True
Else
If Cells(fila, COL + 3) = 18 Then
CheckBox2 = True
End If
End If
ComboBox1.Value = Cells(fila, COL + 4)
If Cells(fila, COL + 2).Value = "Mujer" Then
OptionButton2.Value = True
Else
If Cells(fila, COL + 2).Value = "Hombre" Then
OptionButton1.Value = True
End If
End If
ListBox1.Text = Cells(fila, COL + 5)
BUSCADO = Empty
Range("a2").Select
End Sub
Private Sub TRAER_DATOS2()
fila = ActiveCell.Row
COL = ActiveCell.Column
TextBox1 = Cells(fila, COL - 1)
TextBox2 = Cells(fila, COL)
If Cells(fila, COL + 2) = 18 Then
CheckBox1 = True
Else
If Cells(fila, COL + 2) = 18 Then
CheckBox2 = True
End If
End If
ComboBox1.Value = Cells(fila, COL + 3)
If Cells(fila, COL + 1).Value = "Mujer" Then
OptionButton2.Value = True
Else
If Cells(fila, COL + 1).Value = "Hombre" Then
OptionButton1.Value = True
End If
End If
ListBox1.Text = Cells(fila, COL + 4)
sw = 1
BUSCADO = Empty
Range("a2").Select
End Sub
Sub BORRA_CAMPOS()
sw = 0
TextBox1 = Empty
TextBox2 = Empty
ComboBox1 = Empty
OptionButton1 = False
OptionButton2 = False
CheckBox1 = 0
CheckBox2 = 0
Range("A2:F2").Select
Selection.ClearContents
Range("A2").Select
End Sub
Sub regrabar()
Range("A3:F3").Select
Selection.Copy
Cells(fila + 1, 1).Select
ActiveSheet.Paste
Range("A4:F8000").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-126
Range("A3").Select
ActiveSheet.Paste
BUSCADO = Empty
Range("A2").Select
sw = 0
End Sub
Private Sub VALIDA()
Dim dato1, dato2, revisa1, revisa2 As Integer
dato1 = TextBox1.Value
dato2 = TextBox2.Value
revisa1 = Application.WorksheetFunction.CountIf(Sheets("hoja1").Columns(1), dato1)
revisa2 = Application.WorksheetFunction.CountIf(Sheets("hoja1").Columns(2), dato2)
If revisa1 > 1 Then
If revisa2 > 1 Then
MsgBox "Ese nombre ya existe, no se permiten duplicados. Si lo que desea es modificar vaya a la opción Buscar"
Range("A2:F2").Select
Selection.ClearContents
Else
MsgBox "Hay un nombre o apellido repetido pero Puede continuar"
Exit Sub
End If
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Range("A2:F2").Select
Selection.ClearContents
Range("A2").Select
End Sub