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 Sub

Cualquier ayuda seria muy agradecida.

2 Respuestas

Respuesta
1

[Hola 

Envíame tu archivo y me explicas con un ejemplo. [email protected]

[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
Respuesta
1

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Al seleccionar celda extraer sus dígitos automáticamente

Necesito dos favores, la idea es que al seleccionar una celda numérica de 4 dígitos del rango "af1;aj42" esta automáticamente extraiga sus cifras a la columna "a1, b1, c1, d1" como se muestra en la imagen Y lo segundo como puedo quitarle el msgbox a...
2 respuestas

Se puede agregar voz a Excel

Tengo una pantalla de vuelo de vuelo donde anotó despegues y arribos, Quiero que cada vez que se produzca un despegue y se agregue hora o aterrice alguno y se ponga la hora, excel diga o se escuche atención Aterrizaje o Atención despegue.
3 respuestas

Gráfico Comparativo por Semanas, en Power Bi.

Espero se encuentren muy bien. Tengo una tabla en Power BI con fechas, códigos, costos y cantidades. La necesidad que tengo es de crear un gráfico o tabla donde pueda comparar y analizar el comportamiento de los costos y las cantidades de un código...
1 respuesta

En una lista para pedidos tengo varios formularios

En una lista para pedidos con varios formularios la vengo usando desde hace tiempo sin ningún problema pero hace días la abrí para hacer un pedido y al pisar en el cuadro donde apunta la flecha para que me abra un otro cuadro donde coloco ciertos...
2 respuestas

Código VBA para crear un botón y guardar en PDF

Tengo un archivo word con 7 capturas, una en cada página (1-7), cual seria el código para crear un botón en la barra de herramientas de acceso rápido para convertir en PDF cada página. El resultado seria 7 pdf.
2 respuestas

Como evitar que se duplique un dato en la base de datos

Trato que al ingresar los datos a la base de datos si en la columna "B" DNI es una cifra que ya esta en dicha base me lo indique en un Msgbox "El Dato ya existe" Esta es la macro que tengo en el botón Aceptar Private Sub Aceptar_Click()...
2 respuestas

Detectar si he marcado Celda dentro de un Rango de Excel.

Tengo un Rango en Hoja Excel: RgoDatos >> $B$3:$V$39 Quiero detectar si la celda que selecciono está dentro de ese Rango Si no está que por omisión me marque B3.
1 respuesta

Desproteger un rango de celdas en una hoja protegida

Tengo una aplicación donde en una hoja se ponen comentarios automáticos con una macro, pero como hay celdas donde hay fórmulas las tengo bloqueadas y ocultas para que no se borren por error al usarla, tengo puesto el Unprotect en la macro por que si...
8 respuestas

Dato fecha ya existe en tabla

Como están estimados maestros. En formulario, tengo botón archivar. Envío información a hoja "existencias" a tabla "tbl_existencias". En columna A un Código desde textbox1 En columna B fecha desde textbox "txtFecha2" En columna C total desde textbox2...
2 respuestas

Enviar hoja activa al monitor secundario con vba

He creado una segunda ventana de mi hoja excel con NewWindow, y lo que pretendo es mediante código VBA enviarla al monitor secundario, lo he intentado con Application.SendKeys "^({ESC}+{RIGHT})", pero no lo consigo, con "^{ESC}" estoy tratando de...
2 respuestas