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

Respuesta
2

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 Sub

Adjunto 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
Respuesta
2

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 Sub

Por 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.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas