setfocus no lo entiendo

[JDG]

Hola amigos.

Sinceramente llevo tiempo intentando solucionar este  problema y me da que es cuestion de concepto que algo hago mal.

Anteriormente lo consulte, pero por razones de salud no fue hasta ahora que retomé el proyecto.

Sin ir mas lejos es:

Después de validar en un if then la condicion de vacio de un textbox y por ello retornar el foco a al textbox (txt.textbox.setfocus) en cuestión, lo devuelvo para darle color con textbox. backcolor y todo, ok perfecto. Se que llego correctamente porque lo colorea pero no aparece titilando el cursor por lo que entiendo que no "está disponible"....

¿cual puede ser el motivo?...Está enable=true,  locked=false,  no se que mas revisar....ah! es el tabindex=0 y he hecho varias combinaciones el tabindex, 1, 2.....y nada que lo consigo. 

Lógicamente al activarse el userform y pasar por la subrutina en la que esta la validación, sí se ubica correctamente pero como dije antes al validar y redirigirlo con setfocus pasa lo que comento.

Gracias de verdad por la ayuda que me puedan dar. Creo haber leído todo lo que hay sobre setfocus pero no lo relaciono con mi problema.

José

[Haplox]

@JDG , sube tu archivo, porque lo que explicas no tiene sentido. Quizás alguna incongruencia o algo mal escrito. Además todas esas propiedades que has cambiado no tienen nada que ver con el tema del SetFocus.

[JDG]

Gracias por responder.

 

corto y pego el código espero se entienda. Intente explicar con anotaciones todo.

Gracias de antemano.

-----

Option Explicit
''
''' VARIABLES
''__________________________

Dim contador As Integer
Dim MyRange As Range
Dim Resp As Byte
Dim f As Integer
Dim OpMod As String
Dim Newcont As Integer

''
'''INITIALIZE
''_____________________________

Private Sub UserForm_Initialize()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    txt_BusFecha.TabStop = False
    txt_busId.TabStop = True
    
    Call OultarTítulo(Me)

    'para que al iniciar el form lo haga con la opcion CONSULTA como predeterminada ademas del
    'titulo CONSULTA y el boton Reemplazar oculto, además de estar protegida la informacion

    InterfaceCon

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

''
''' BUSCAR REGISTRO
'' ______________________

Private Sub Cmd_Buscar_click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim FILA, FINAL, I As Integer

Call OultarTítulo(Me)

'para que al iniciar el form lo haga con la opcion CONSULTA como predeterminada ademas del
'titulo CONSULTA y el boton Reemplazar oculto, además de estar protegida la informacion
    
InterfaceCon

'EMPIEZA LA BUSQUEDA

    If txt_busId = Empty Then
        MsgBox "DEBE INGRESAR EL ID DE OPERACION PARA REALIZAR LA BUSQUEDA", vbExclamation
        txt_busId.BackColor = &H8080FF 'da color al fondo del txt
        txt_busId.SetFocus
 
 
        Exit Sub 'sale de la subrutina para volver a consultar
    End If
    
    'Continúa ya que no está vacio
    If txt_busId < Chr(48) Or txt_busId > Chr(57) Then
        MsgBox "EL ID DEBE SER NUMERO", vbExclamation
        txt_busId = Empty
        txt_busId.BackColor = &H8080FF 'da color al fondo del txt
        txt_busId.SetFocus
        Exit Sub 'sale de la subrutina para volver a consultar
     End If
        'Continúa ya que es número
        
        
        'OBTENER LA FILA DE LA CELDA QUE CONTIENE EL ID
       FILA = 4
                Do While Hoja06.Cells(FILA, 4) <> Empty  '
                    FILA = FILA + 1
         Loop
        
        FINAL = FILA - 1 'el while loop nos daría la primera  fila vacia, le restamos una para obtene la ultima llena
                
                For I = 4 To FINAL     'avanza por toda las llevas
                    If txt_busId.Text = Hoja06.Cells(I, 2) Then
                    
                        txt_BusFecha.Text = Hoja06.Cells(I, 4)
                        
                        txt_BusDescripcion.Text = Hoja06.Cells(I, 5)
                        txt_BusNaturaleza.Text = Hoja06.Cells(I, 6)
                        'hacer roja el campo de Naturaleza cuando sea un Débito
                            If Me.txt_BusNaturaleza = "Débito" Then
                                    Me.txt_BusNaturaleza.ForeColor = vbRed
                                    Me.txt_BusImporte.ForeColor = vbRed
                                    Else
                                        Me.txt_BusNaturaleza.ForeColor = vbBlack
                                        Me.txt_BusImporte.ForeColor = vbBlack
                            End If
                            
                        'Da formato al campo BusImporte
                        Txt_BusOperacion.Text = Hoja06.Cells(I, 7)
                        Txt_BusFondo.Text = Hoja06.Cells(I, ?
                        txt_BusImporte.Value = Hoja06.Cells(I, 9)
                        txt_BusImporte.Value = Format(Me.txt_BusImporte.Value, "#,##0.00")
                    
                        'CONFIRMACION DE EXTRACCION EN BUSQUEDA
                        'se crea un mensaje que se cierra automaticamente
                        CreateObject("wscript.shell").Popup "¡DATOS EXTRAIDOS CON ÉXITO!...", 1, "Mensaje"
                  
                        'Sale de la subrutina al ya haber extraido los campos
                        txt_busId.SetFocus
                        Exit Sub
                        
                        End If
                Next I
       
                    txt_BusFecha = Empty
                    txt_BusDescripcion = Empty
                    txt_BusNaturaleza = Empty
                    Txt_BusOperacion = Empty
                    Txt_BusFondo = Empty
                    txt_BusImporte = Empty

                 MsgBox "NO SE ENCONTRO EL DATO"
                 txt_busId = Empty
                 txt_busId.SetFocus

End Sub

'BOTON ULTIMO REGISTRO

Private Sub cmd_UltRegistro_Click()
    
    Dim RegistroAnterior As Integer
    Dim UltId As String
    Dim UltFecha As String
    Dim UltDescripcion As String
    Dim UltNaturaleza As String
    Dim UltOperacion As String
    Dim UltFondo As String
    Dim UltImporte As String
    Dim MyRange As Range
    Dim contador As Integer
    Dim Filabuscada As Integer
    Dim busco As Object
    
    Dim FILA As Integer
    Dim FINAL As Integer
    
    
    ' Calcula el ultimo numero utilizado en la BDD
    
    Set MyRange = Worksheets("BDD").Range("B4:B3003")
    contador = Application.WorksheetFunction.Max(MyRange)
    UltId = contador
    
    
    Set busco = Sheets("BDD").Range("b4:b3003").Find(UltId)
    Filabuscada = busco.Row
    
    
    UltFecha = Hoja06.Cells(Filabuscada, 4).Value
    UltDescripcion = Hoja06.Cells(Filabuscada, 5).Value
    UltNaturaleza = Hoja06.Cells(Filabuscada, 6).Value
    UltOperacion = Hoja06.Cells(Filabuscada, 7).Value
    UltFondo = Hoja06.Cells(Filabuscada, 8).Value
    UltImporte = Hoja06.Cells(Filabuscada, 9).Value
    
    
    MsgBox "ULTIMO ID        :  " + UltId _
    & Chr(13) + "FECHA              :  " + UltFecha _
    & Chr(13) + "DESCRIPCION  :  " + UltDescripcion _
    & Chr(13) + "NATURALEZA    :  " + UltNaturaleza _
    & Chr(13) + "OPERACION     :  " + UltOperacion _
    & Chr(13) + "FONDO            :  " + UltFondo _
    & Chr(13) + "IMPORTE          :  " + UltImporte, 0, "                   ULTIMO REGISTRO"
    
End Sub

''
'''  CONFIGURACIONES
''  ________________

''segun la opcion seleccionada en el optionbutton oculta
''o muestra el boton de reemplezar y cambia el titulo al userform potegiendo los campos en caso de ser consuta
'

Private Sub bt_opModNo_change()
    
    If BT_OpModSI = True Then
        InterfaceMod
        
    Else
       
        InterfaceCon
        
        
        
    End If
End Sub

''
'''  MASCARAS
'' ___________

'para colocar los guiones en las fechas automaticamente

Private Sub txt_BusFecha_change()
    'seleccionamos de acuerdo a la longitud de los datos que vamos ingresando
    Select Case Len(txt_BusFecha.Value)
    Case 2
        'si el textbox tiene 2 caracteres
        txt_BusFecha.Value = txt_BusFecha.Value & " "
    Case 5
        'si el textbox tiene 5 caracteres
        txt_BusFecha.Value = txt_BusFecha.Value & " "
    End Select
End Sub

''
''' BOTON LIMPIAR FORMULARIO
''  _______________________

Private Sub cmdLimpiarfrmBusqueda_Click()
    
    LimpiarfrmBusqueda
    
    txt_busId.SetFocus
    
    
End Sub

''
''' BOTON CERRAR FORMULARIO
''  _______________________

Private Sub cmdCerrarFrmBusqueda_Click()
    LimpiarfrmBusqueda
    Unload Me
End Sub

''
''' BOTON REEMPLAZAR
''  _______________________

Private Sub CMD_REEMPLAZAR_Click()
    
    Dim FILA, FINAL, I, MENSAJE As Integer
    
    FILA = 4
    
    'VALIDACION DE TODOS LOS CAMPOS COMPLETOS
    If txt_busId = Empty Or txt_BusFecha = Empty Or txt_BusDescripcion = Empty Or txt_BusNaturaleza = Empty Or Txt_BusOperacion = Empty Or Txt_BusFondo = Empty Or txt_BusImporte = Empty Then
        MsgBox "ES NECESARIO LLENAR TODOS LOS CAMPOS DEL FORMULARIO", vbExclamation
        txt_busId.SetFocus
        Exit Sub
    Else
        'MENSAJE PARA ELEGIR SI O NO PROCESAR LA MODIFICACION DE DATOS
        MENSAJE = MsgBox("¿ESTAS SEGURO DE MODIFICAR LOS DATOS?", vbQuestion + vbYesNo)
        If MENSAJE = vbYes Then
            'CODIGO QUE EN CUENTRA LA ULTIMA FILA OCUPADA Y SE DESPLAZA UNA FILA HACIA ABAJO ENCONTRANDO LA PRIMER FILA DESOCUPADA DESCENDIENTEMENTE
            Do While Hoja06.Cells(FILA, 2) <> Empty
                FILA = FILA + 1
            Loop
            FINAL = FILA - 1
            'CICLO QUE UBICA EL NUMERO DE txt_busId PARA PODER MODIFICAR ESA FILA
            For FILA = 4 To FINAL
                If Me.txt_busId.Text = Hoja06.Cells(FILA, 2).Value Then  'cuando es igual lo ha encontrado y continua
                    'pasa los nuevos valores a la BDD
                    Hoja06.Cells(FILA, 4).Text = Me.txt_BusFecha.Text
                    Hoja06.Cells(FILA, 5).Value = Me.txt_BusDescripcion.Text
                    Hoja06.Cells(FILA, 6).Value = Me.txt_BusNaturaleza.Text
                    Hoja06.Cells(FILA, 7).Value = Me.Txt_BusOperacion.Text
                    Hoja06.Cells(FILA, 8).Value = Me.Txt_BusFondo.Text
                    Hoja06.Cells(FILA, 9).Value = Me.txt_BusImporte.Value
                    'VACIAR LOS CAMPOS
                    txt_busId.Text = Empty
                    txt_BusFecha.Text = Empty
                    txt_BusDescripcion.Text = Empty
                    txt_BusNaturaleza.Text = Empty
                    Txt_BusOperacion.Text = Empty
                    Txt_BusFondo.Text = Empty
                    txt_BusImporte.Value = Empty
                    Exit For 'y sale del for
                End If
            Next
            MsgBox "¡DATOS MODIFICADOS CON EXITO!"
        Else
            MsgBox "INGRESO DE NUEVOS DATOS CANCELADO", vbExclamation
            Exit Sub
        End If
    End If
End Sub

 

 

[Haplox]

@JDG ¿Pero de verdad crees que se puede mirar TODO ESE CÓDIGO y encontrar un fallo? Sube tu archivo para poder depurar

[JDG]

Hace 10 horas, Haplox dijo:

@JDG ¿Pero de verdad crees que se puede mirar TODO ESE CÓDIGO y encontrar un fallo? Sube tu archivo para poder depurar

Ese e el userform que me da problemas

 

[Haplox]

Hace 12 minutos , JDG dijo:

Ese e el userform que me da problemas

En fin... ?

[Antoni]

Sube tu archivo con el Userform. ¿No entiendes que es imposible hacer nada sin él? ?

[JDG]

En 24/5/2020 at 20:50 , Antoni dijo:

Sube tu archivo con el Userform. ¿No entiendes que es imposible hacer nada sin él? ?

Gracias Antoni, pero con  tanto pensar me recordé de un comentario que una vez lei: "no puedes enviar nada a donde ya está"....

Lo que he hecho es enviarlo a otro textbox primero y luego si al que es con set focus. 

Se que es una chapuza pero me funcionó. 

Claro siempre me quedará la duda de donde es que esta el problema.

Un saludo.