No me funciona TextBox1.Setfocus
Me podrias ayudar con este código. Te explico, ya logre que busque el dato en la Base de daros y me traiga los valores que quiero. Pero cuando no lo encuentra me salia error, entonces lo solucione con el comando On Error Goto, pero cuando pasa eso no logro que se devuelva al Textbox1.
'Evento que Busca el dato en la BD
Private Sub TextBox1_AFTERUPDATE()
Dim Nombre As String
Dim Rango As Range
Set Rango = Sheets(1).Range("A1:AZ4000") 'Se define la BD
On Error GoTo Error: 'Si no se encuentra el dato en la BD
INDICE = Application.WorksheetFunction.Match(Val(TextBox1.Text), Rango.Columns(1), 0) 'Busca el Dato
Me.Label1.Caption = Rango.Cells(INDICE, 2) 'Encuentra y muestra el Nombre
Me.Label2.Caption = Rango.Cells(INDICE, 13) 'Encuentra y muestra el Programa
Me.Label3.Caption = Rango.Cells(INDICE, 28) 'Encuentra y muestra el Tipo de Documento
Me.Label4.Caption = Rango.Cells(INDICE, 29) 'Encuentra y muestra el Documento
Me.Label5.Caption = Rango.Cells(INDICE, 35) 'Encuentra y muestra el Genero
Exit Sub 'Se detiene si hay error
Error:
MsgBox "No se encontró" 'mensaje si no encuentra el dato en la BD
TextBox1 = Empty 'Vacía el campo de texto
TextBox1.SetFocus 'Ubica el puntero en el campo de texto
End Sub
2 Respuestas
La instrucción afterupdate solo funciona cuando tienes otro objeto activo como un commandbutton, optionbutton, checkbox u otro textbox solo que cuando llenas el campo estos campos anulan el setbox y pasan el control al otro objeto activo ahora bien si tienes objetos pasivos como una label la instrucción afterupdate no funcionara hasta que cierres el archivo, esa es una la otra es on error resume next en este caso no es conveniente usarlo en vez de eso usa un countif si este valor es mayor a 0 significa que el dato existe y continua la instrucción haciendo la comparación con el match pero apra que esto funcione requieres cambiar el evento afterupdate por dobleclick o por un commandbutton, estas son las únicas opciones que harán que el Setfocus funcione y esta es la macro
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Nombre As String
Dim Rango As Range
Set Rango = Sheets(1).Range("A1:AZ4000") 'Se define la BD
cuenta = WorksheetFunction.CountIf(Rango.Columns(1), TextBox1.Text)
If cuenta > 0 Then
INDICE = WorksheetFunction.Match(Val(TextBox1.Text), Rango.Columns(1), 0) 'Busca el Dato
Me.Label1.Caption = Rango.Cells(INDICE, 2) 'Encuentra y muestra el Nombre
Me.Label2.Caption = Rango.Cells(INDICE, 13) 'Encuentra y muestra el Programa
Me.Label3.Caption = Rango.Cells(INDICE, 28) 'Encuentra y muestra el Tipo de Documento
Me.Label4.Caption = Rango.Cells(INDICE, 29) 'Encuentra y muestra el Documento
Me.Label5.Caption = Rango.Cells(INDICE, 35) 'Encuentra y muestra el Genero
Else
MsgBox "No se encontró" 'mensaje si no encuentra el dato en la BD
End If
TextBox1 = Empty 'Vacía el campo de texto
TextBox1.SetFocus 'Ubica el puntero en el campo de texto
End Sub
Buen día, Gracias por la aclaración. ¿Es posible tener otra opción que no sea con doble Clic? l
'Evento que Busca el dato en la BD
Private Sub TextBox1_AFTERUPDATE()
Dim Nombre As String
Dim Rango As Range
Set Rango = Sheets(1).Range("A1:AZ4000") 'Se define la BD
INDICE = Application.WorksheetFunction.Match(Val(TextBox1.Text), Rango.Columns(1), 0) 'Busca el Dato
Me.Label1.Caption = Rango.Cells(INDICE, 2) 'Encuentra y muestra el Nombre
Me.Label2.Caption = Rango.Cells(INDICE, 13) 'Encuentra y muestra el Programa
Me.Label3.Caption = Rango.Cells(INDICE, 28) 'Encuentra y muestra el Tipo de Documento
Me.Label4.Caption = Rango.Cells(INDICE, 29) 'Encuentra y muestra el Documento
Me.Label5.Caption = Rango.Cells(INDICE, 35) 'Encuentra y muestra el Genero
End Sub
'Evento para guardar las entradas
Private Sub CommandButton1_Click()
Dim hora As String
Dim fecha As String
hora = Format(Time, "hh:mm:ss")
fecha = Format(Date, "dd/mm/yyyy")
Sheets(2).Activate 'Activa la hoja 2 Entradas
ActiveSheet.Cells(2, 1).Select 'Activa la celda A2
If Trim(TextBox1.Text) = "" Then 'Verifica que el Campo no este vacio
MsgBox "No hay ID"
TextBox1.SetFocus
Else
Selection.EntireRow.Insert 'Inserta una fila en la tabla
'Agrega los datos que se encontraron
ActiveSheet.Cells(2, 1) = fecha
ActiveSheet.Cells(2, 2) = UserForm1.Label1.Caption
ActiveSheet.Cells(2, 3) = UserForm1.Label2.Caption
ActiveSheet.Cells(2, 4) = UserForm1.Label3.Caption
ActiveSheet.Cells(2, 5) = UserForm1.Label4.Caption
ActiveSheet.Cells(2, 6) = UserForm1.Label5.Caption
ActiveSheet.Cells(2, 10) = hora
'Limpia las Etiquetas
UserForm1.Label1 = Empty
UserForm1.Label2 = Empty
UserForm1.Label3 = Empty
UserForm1.Label4 = Empty
UserForm1.Label5 = Empty
TextBox1.SetFocus
End If
End Sub
'Evento para guardar las Salidas
Private Sub CommandButton2_Click()
Dim hora As String
Dim fecha As String
hora = Format(Time, "hh:mm:ss")
fecha = Format(Date, "dd/mm/yyyy")
Sheets(3).Activate 'Activa la hoja 3 Salidas
ActiveSheet.Cells(2, 1).Select 'Activa la celda A2
If Trim(TextBox1.Text) = "" Then 'Verifica que el Campo no este vacio
MsgBox "No hay ID"
TextBox1.SetFocus
Else
Selection.EntireRow.Insert 'Inserta una fila en la tabla
'Agrega los datos que se encontraron
ActiveSheet.Cells(2, 1) = fecha
ActiveSheet.Cells(2, 2) = UserForm1.Label1.Caption
ActiveSheet.Cells(2, 3) = UserForm1.Label2.Caption
ActiveSheet.Cells(2, 4) = UserForm1.Label3.Caption
ActiveSheet.Cells(2, 5) = UserForm1.Label4.Caption
ActiveSheet.Cells(2, 6) = UserForm1.Label5.Caption
ActiveSheet.Cells(2, 10) = hora
'Limpia las Etiquetas
UserForm1.Label1 = Empty
UserForm1.Label2 = Empty
UserForm1.Label3 = Empty
UserForm1.Label4 = Empty
UserForm1.Label5 = Empty
TextBox1.SetFocus
End If
End SubAdjunto todo el codigo que tengo. Mi idea es que al encontrar el dato en la base de datos lo pueda escribir en una hoja de entrada o salida, con cada botón. Creo que me funciona, el problema esta cuando no encuentra el dato.
Ya te explique que con el error resume next en este caso es más un problema que una solución, necesitas crear una variable de control como cuenta, mira la siguiente macro cada que tecles algo en el textbox inmediatamente lo buscara en el rango asignado sino lo encuentra pondrá las etiquetas en blanco y regresara el control al textbox como quieres, no se puede pedir que la macro limpie el textbox pues caerías en un ciclo sin fin para ello se necesitaría establecer otra variable de control o poner un controlbutton para limpie el campo, por cierto cambie el aferupdate por el evento change
Private Sub TextBox1_change()
Dim Nombre As String
Dim Rango As Range
Set Rango = Sheets(1).Range("A1:AZ4000") 'Se define la BD
cuenta = WorksheetFunction.CountIf(Rango.Columns(1), Val(TextBox1.Text))
If cuenta > 0 Then
INDICE = Application.WorksheetFunction.Match(Val(TextBox1.Text), Rango.Columns(1), 0) 'Busca el Dato
With Rango
Me.Label1.Caption = .Cells(INDICE, 2) 'Encuentra y muestra el Nombre
Me.Label2.Caption = .Cells(INDICE, 13) 'Encuentra y muestra el Programa
Me.Label3.Caption = .Cells(INDICE, 28) 'Encuentra y muestra el Tipo de Documento
Me.Label4.Caption = .Cells(INDICE, 29) 'Encuentra y muestra el Documento
Me.Label5.Caption = .Cells(INDICE, 35) 'Encuentra y muestra el Genero
End With
Else
TextBox1.SetFocus
For i = 1 To 5
UserForm1.Controls("label" & i) = ""
Next i
End If
Te recomiendo utilizar el evento Exit en lugar del que estás utilizando.
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'si la celda se limpia o queda vacía el proceso continúa
If TextBox1 = "" Then Exit Sub
Dim Nombre As String
Dim Rango As Range
Set Rango = Sheets(1).Range("A1:AZ4000") 'Se define la BD
On Error GoTo Error: 'Si no se encuentra el dato en la BD
INDICE = Application.WorksheetFunction.Match(Val(TextBox1.Text), Rango.Columns(1), 0) 'Busca el Dato
Me.Label1.Caption = Rango.Cells(INDICE, 2) 'Encuentra y muestra el Nombre
Me.Label2.Caption = Rango.Cells(INDICE, 13) 'Encuentra y muestra el Programa
Me.Label3.Caption = Rango.Cells(INDICE, 28) 'Encuentra y muestra el Tipo de Documento
Me.Label4.Caption = Rango.Cells(INDICE, 29) 'Encuentra y muestra el Documento
Me.Label5.Caption = Rango.Cells(INDICE, 35) 'Encuentra y muestra el Genero
Exit Sub 'Se detiene si hay error
Error:
MsgBox "No se encontró" 'mensaje si no encuentra el dato en la BD
Cancel = True
TextBox1 = Empty 'Vacía el campo de texto
TextBox1.SetFocus 'Ubica el puntero en el campo de texto
End SubPor supuesto que tiene que haber algún otro control para que se produzca el Exit o salida de tu textbox.
Gracias por la respuesta, decidí poner un Botón para Validar los datos. Pero así como le pregunte al Otro Experto que me colaboro, Es posible que al darle Salida, me valide que el usuario ya está en la lista y en Su respectiva Celda ponga la Hora de Salida?
Ya habrás visto que con el evento Exit te permite limpiar y volver al Textbox habiéndolo limpiado antes (Perdón James pero sí se puede limpiar y volver a este control con este evento ;)
Y si el dato está encontrado te habrá mostrado el resto de las celdas de ese registro... pasando el foco a otro control.
Si es el botón de SALIDA ya tendrás la fila del registro con la variable INDICE que debe ser declarada dentro del Userform al inicio de todo con esta instrucción:
Dim INDICE as Long 'puede ser Integer dependiendo de la cantidad de filas de tu base.
Y la macro del botón SALIDA tendrá la instrucción del pase... lo que no se es en qué columna quieres la hora de salida... ajusta la siguiente instrucción:
Private Sub CommandButton1_Click() 'botón SALIDA 'x Elsamatilde 'reemplazar ActiveSheet por la hoja de la tabla y la col 3 por la de la hora de salida. ActiveSheet.Cells(INDICE, 3) = Time 'otras posibles instrucciones End Sub
Sdos y ahora sí no olvides valorar la respuesta. Ya te respondí 2 temas en 1 misma consulta. Por nuevas dudas deja nuevas consultas en el tablón indicando en su título cuál es el tema.