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

Error en código para columna de una consulta

Un gusto saludarlos. Quería solicitar su ayuda, porque necesito crear una columna calculada dentro de una consulta access y para eso uso el siguiente código. Saldofinal: IIf(([Nivel]=1 Or [Nivel]=5), ([Sumadesaldoinicial]+[Sumadebe]-[Sumahaber]),...
2 respuestas

Optimizar macro para combinar filas

Tengo una macro que acumula valores de filas determinados según columnas similares, funciona bien con una tabla de datos intermedia en cuanto a su tiempo de ejecución, lo que quiero es optimizar esta macro o mejorarla ya que tengo tablas de hasta...
3 respuestas

Como hacer una consulta de access que me arroje suma por niveles de cuenta.

Un gusto saludarlos. Les comento, estoy haciendo un pequeño programa contable para un pequeño negocio que abrí, el asunto es que no se como crear una consulta, que me permita visualizar. 1. La suma por niveles (nivel 1 primer dígito del campo...
3 respuestas

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...
12 respuestas

Liberalizar la memoria después de realizar cálculos

En un formulario ejecuto diferentes instrucciones para cálculos de unos totales que he de traspasar a otro formulario a través de un botón. Estoy teniendo el problema que al finalizar el proceso del calculo, me desaparece la pantalla y no puedo...
3 respuestas

Agregar campos de texto en un formulario en ejecución.

Un gusto saludarlos. Tengo un formulario llamado estudiante que viene de una tabla llamada estudiante. Cada estudiante ve un número diferente de asignaturas y asignaturas diferentes. El formulario arranca con los siguientes Campos número de cédula...
2 respuestas

No me funciona el conector AND en el código visual de acces

Un gusto saludarlos. Quisiera saber cómo puedo hacer para que me funcione el conector AND en el código visual de una base de datos hecha en access. Resulta que empecé a hacer un proyecto, pero cuando dentro de un ciclo if, utilizo la palabra AND el...
3 respuestas

Ordenar listado en excel por numero de tienda

Tengo un listado de productos en excel y en la misma celda viene el numero de la tienda y los totales de cada tienda, pero si tengo más de 100 tiendas quiero agregar una columna donde me diga que tienda es y así poder ordenar mi listado por el número...
1 respuesta

Hacer un nuevo archivo copiando la hoja2 y hoja3 de una lista de nombres que están en la hoja1.

En la hoja1 tengo una lista de nombres y quiero copiar la hoja=evaluación y hoja=metas a un nuevo libro con el nombre de la lista de la hoja1 las dos hojas en el mismo nuevo libro.
1 respuesta

Tengo una macro , que necesita que de una lista de alumnos

Imprime un informe de un alumno en particular, necesito que el usuario digite un numero y luego siga con los pasos siguientes, es decir que imprima el usuario seleccionado . ¿Cómo puedo pausar una macro?
2 respuestas