Limitar fechas en text box

[Felixin76]

Buenas a todos los forer@s

Estoy realizando un userform con varios textbox y combo box y estoy bloqueado en un punto en el cual me gustaria que me ayudasen con ello

necesito limitar un textbox con  la fecha ,que no se vaya de valores minimo y maximos que indique

Quiero limitar el textbox con las fechas 01/01/23  ----31/12/23 

Me podrian ayudar con este tema 

Un saludo  y muchas gracias por su tiempo 

 

[Felixin76]

adjunto vba que tengo programada

Private Sub TextBoxFEGA_Change()

'Limitar valores de Fecha en FEGA
    If Bandera = False Then
    
        If Len(TextBoxFEGA.Value) > 10 Then
            TextBoxFEGA.Value = Mid(TextBoxFEGA.Value, 1, 10)
            MsgBox "La fecha esta completa"
        Else
            If Len(TextBoxFEGA.Value) = 2 Then
                TextBoxFEGA.Value = TextBoxFEGA.Value & "/"
            End If
    
            If Len(TextBoxFEGA.Value) = 5 Then
                 TextBoxFEGA.Value = TextBoxFEGA.Value & "/23"
            End If
        End If
    End If
'Acotar fecha en textboxFEGA
    
    Dim Fecha_Inicial As Date
    Dim Fecha_Final As Date
    'Dim Fecha_Actual As Date
    
   Fecha_Inicial = 1 / 1 / 2023
   Fecha_Final = 31 / 12 / 2023
   'Fecha_Actual = TextBoxFEGA.Value
   
    'If Fecha_Actual > Fecha_Incial Or Fecha_Actual < Fecha_Final Then
    If Bandera > Fecha_Incial Or Bandera < Fecha_Final Then
        TextBoxDEGA.Enabled = True
    Else
        If TextBoxFEGA <> "" Then
            MsgBox "FECHA NO PERMITIDA"
        End If
    Exit Sub
   End If
    
    
    If TextBoxFEGA <> "" Then
        TextBoxDEGA.Enabled = True
    End If
End Sub
    
Private Sub TextBoxFEGA_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

   If KeyCode = 8 Then
    Bandera = True
    
   
   Else
    Bandera = False
   End If
   
End Sub

[Antoni]

Sube tu archivo para poder probar.

[Felixin76]

pesa mucho y no me deja enviar 

 

 

[Felixin76]

te envio mi el codigo de mi user form

'CLICK BOTON "OK" FORMULARIO ANOTAR GASTO
Private Sub CommandButton1_Click()
ARCHIVAR_GASTO

BORRAR_DATOS
UserFormGASTO.Hide

End Sub

'CLICK BOTON "LIMPIAR" FORMULARIO ANOTAR GASTO
Private Sub CommandButton2_Click()
    'LIMPIAR DATOS DEL FORMULARIO DE INGRESOS
    BORRAR_DATOS
End Sub

'CÓDIGO USERFORM – EVENTO INITIALIZE
'‘Evento: Activate – Cada vez que el formulario inicie

Private Sub UserForm_Activate()

BORRAR_DATOS

'‘Seleccionar la hoja donde se encuentra la base de datos
Sheets("BD1").Select

'‘Calcular la ultima fila de dicha base de datos, tomando

'‘como referencia la columna A

ultfila = Columns("A:A").Range("A" & Rows.Count).End(xlUp).Row

'‘Bucle para cargar los datos al combobox6 (Tipo)

For fila = 2 To ultfila

'‘Si la referencia es diferente de vacío

'‘Cargar los datos al combobox6

If Cells(fila, 1) <> "" Then

ComboBox6.AddItem (Cells(fila, 1))

End If

Next

'‘Seleccionar la hoja Destino

Sheets("DATA BOARD").Select

End Sub

'CÓDIGO COMBOBOX6 – EVENTO: CHANGE

'‘Evento: Change- Cada vez que suceda cambios en el combobox6 (Tipo)

Private Sub ComboBox6_Change()

'‘Limpiar el combobox5 (Marca)
ComboBox5.Clear

    
'‘Seleccionar la hoja BD1

Sheets("BD1").Select

'‘Validar la celda a cargar en el combobox5 (Marca)

'‘dependiente del combobox6 (Tipo)

columna = ComboBox6.ListIndex + 3

Cells(2, columna).Select

ultfila = Columns("A:A").Range("A" & Rows.Count).End(xlUp).Row

'‘Bucle para cargar los datos de la columna seleccionada al combobox5 (Marca)

For fila = 2 To ultfila

'‘Si la selección es diferente de vacío cargar los datos al combobox5 (Marca)

If Cells(fila, columna) <> "" Then

ComboBox5.AddItem (Cells(fila, columna))

End If

Next

'‘Seleccionar la hoja Destino

Sheets("DATA BOARD").Activate

End Sub

'BORRA DATOS DEL FORMULARIO
Sub BORRAR_DATOS()

    Sheets("Categorias Gastos").Activate
    Range("U7:Y7").ClearContents
    Sheets("DATA BOARD").Activate
    Range("A1").Activate
End Sub
 

 

 

[Felixin76]

Perdon

Este es el correcto

Dim Bandera As Boolean

'GASTOS.................................................................................

'CÓDIGO USERFORM – EVENTO INITIALIZE
'‘Evento: Activate – Cada vez que el formulario inicie
Private Sub UserForm_Activate()

BORRAR_DATOS
CommandButtonOKGA.Enabled = False
TextBoxFEGA.Enabled = False
TextBoxDEGA.Enabled = False
TextBoxIMGA.Enabled = False

'‘Seleccionar la hoja donde se encuentra la base de datos
Sheets("BD1").Select

'‘Calcular la ultima fila de dicha base de datos, tomando

'‘como referencia la columna A

ultfila = Columns("A:A").Range("A" & Rows.Count).End(xlUp).Row

'‘Bucle para cargar los datos al combobox6 (Tipo)

For fila = 2 To ultfila

'‘Si la referencia es diferente de vacío

'‘Cargar los datos al comboboxGRGA

    If Cells(fila, 1) <> "" Then

    ComboBoxGRGA.AddItem (Cells(fila, 1))

    End If

    Next

'‘Seleccionar la hoja Destino

Sheets("DATA BOARD").Select

End Sub

'CÓDIGO COMBOBOXGRGA – EVENTO: CHANGE

'‘Evento: Change- Cada vez que suceda cambios en el comboboxGRGA (Tipo)

Private Sub ComboBoxGRGA_Change()

'‘Limpiar el comboboxCOGA (Marca)
ComboBoxCOGA.Clear

    
'‘Seleccionar la hoja BD1

Sheets("BD1").Select

'‘Validar la celda a cargar en el combobox5 (Marca)

'‘dependiente del comboboxGRGA (Tipo)

columna = ComboBoxGRGA.ListIndex + 3

Cells(2, columna).Select

ultfila = Columns("A:A").Range("A" & Rows.Count).End(xlUp).Row

'‘Bucle para cargar los datos de la columna seleccionada al comboboxCOGA (Marca)

For fila = 2 To ultfila

'‘Si la selección es diferente de vacío cargar los datos al comboboxCOGA (Marca)

    If Cells(fila, columna) <> "" Then

    ComboBoxCOGA.AddItem (Cells(fila, columna))

    End If

    Next

'‘Seleccionar la hoja Destino

Sheets("DATA BOARD").Activate

End Sub
Private Sub ComboBoxCOGA_Change()
     If ComboBoxCOGA <> "" Then
        TextBoxFEGA.Enabled = True
     End If
End Sub

Private Sub TextBoxFEGA_Change()

    If Bandera = False Then
    
        If Len(TextBoxFEGA.Value) > 10 Then
            TextBoxFEGA.Value = Mid(TextBoxFEGA.Value, 1, 10)
            MsgBox "La fecha esta completa"
        Else
            If Len(TextBoxFEGA.Value) = 2 Then
                TextBoxFEGA.Value = TextBoxFEGA.Value & "/"
            End If
    
            If Len(TextBoxFEGA.Value) = 5 Then
                 TextBoxFEGA.Value = TextBoxFEGA.Value & "/23"
            End If
        End If
    End If
    
    Dim Fecha_Inicial As Date
    Dim Fecha_Final As Date
    'Dim Fecha_Actual As Date
    
   Fecha_Inicial = 1 / 1 / 2023
   Fecha_Final = 31 / 12 / 2023
   'Fecha_Actual = TextBoxFEGA.Value
   
    'If Fecha_Actual > Fecha_Incial Or Fecha_Actual < Fecha_Final Then
    If Bandera > Fecha_Incial Or Bandera < Fecha_Final Then
        TextBoxDEGA.Enabled = True
    Else
        If TextBoxFEGA <> "" Then
            MsgBox "FECHA NO PERMITIDA"
        End If
    Exit Sub
   End If
    
    
    If TextBoxFEGA <> "" Then
        TextBoxDEGA.Enabled = True
    End If
End Sub
    
Private Sub TextBoxFEGA_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

   If KeyCode = 8 Then
    Bandera = True
    
   
   Else
    Bandera = False
   End If
   
End Sub

 

Private Sub TextBoxDEGA_Change()

    If TextBoxDEGA <> "" Then
        TextBoxIMGA.Enabled = True
    End If
    
End Sub
Private Sub TextBoxIMGA_Change()
    If TextBoxIMGA <> "" Then
        CommandButtonOKGA.Enabled = True
    End If
    'SOLO INTRODUCIR VALOR NUMERICO
      Dim Texto As Variant
    Dim Caracter As Variant
    Dim Largo As Integer
    On Error Resume Next
    Texto = Me.TextBoxIMGA.Value
    Largo = Len(Me.TextBoxIMGA.Value)
    For i = 1 To Largo
        Caracter = Mid(Texto, i, 1)
        If Caracter <> "" Then
            If Caracter < Chr(48) Or Caracter > Chr(57) Then
                Me.TextBoxIMGA.Value = Replace(Texto, Caracter, "")
            Else
            End If
        End If
    Next i
    On Error GoTo 0
    Caracter = 0
    Caracter1 = 0
End Sub

'CLICK BOTON "OK" FORMULARIO ANOTAR GASTO

Private Sub CommandButtonOKGA_Click()

If ComboBoxGRGA = "" Then
        MsgBox "Introducir GRUPO"
        ComboBoxGRGA.SetFocus
    End If

If ComboBoxCOGA = "" Then
        MsgBox "Introducir CONCEPTO"
        ComboBoxCOGA.SetFocus
    End If

If TextBoxFEGA = "" Then
        MsgBox "Introducir FECHA"
        TextBoxFEGA.SetFocus
    End If

If TextBoxDEGA = "" Then
        MsgBox "Introducir DESCRIPCION"
        TextBoxDEGA.SetFocus
    End If

If TextBoxIMGA = "" Then
        MsgBox "Introducir IMPORTE"
        TextBoxIMGA.SetFocus
    End If
    
ARCHIVAR_GASTO

BORRAR_DATOS
UserFormGASTO.Hide

End Sub

'CLICK BOTON "LIMPIAR" FORMULARIO ANOTAR GASTO
Private Sub CommandButtonLIGA_Click()
    'LIMPIAR DATOS DEL FORMULARIO DE GASTO
    BORRAR_DATOS
End Sub
'BORRA DATOS DEL FORMULARIO
Sub BORRAR_DATOS()

    Sheets("Categorias Gastos").Activate
    Range("U7:Y7").ClearContents
    Sheets("DATA BOARD").Activate
    Range("A1").Activate
End Sub
 

 

 

Muchas gracias por tu ayuda

Un saludo

 

[Antoni]

Crea un archivo .xlsm solo con el formulario y podrás subirlo, comprende que sin él es imposible hacer nada.

[Felixin76]

 

Aqui te lo envio 

Mil gracias

Libro1.xlsm

[Antoni]

Prueba el adjunto.

Libro1 (6).xlsm

[Felixin76]

Buenas Antoni 

Muchas gracias por tu aporte ,grandioso¡¡

Pero me surge una cuestión:

me gustaría que el textbox del cual estamos hablando ,cuando introduzca una fecha fuera de ese rango marcado ,no me deje introducir datos en el textbox siguiente, pero cuando entre dentro del valor si que me deje continuar introduciendo datos en el siguiente box

Así evito que si es valor fuera de rango ,continúe con la macro, obligando a introducir el valor correcto 

me podrías echar una manilla??

Muchas gracias por tu tiempo y ayuda 

Saludos

[Felixin76]

Esto sucede cuando en el textboxFEGA introduzco un valor correcto ,me activa la siguiente textboxDEGA,

Pero si modifico después ese valor (textboxFEGA) y lo introduzco con un valor fuera de rango ,se mantiene activo el textboxDEGA y eso es lo que quiero evitar 

Como puedo proceder ??

Muchas gracias 

[Nancy]

he corregido el código espero te sirva

 

Private Sub TextBoxFEGA_Change()
    
    'Definir variables
    Dim Fecha_Inicial As Date
    Dim Fecha_Final As Date
    
    'Convertir fecha de inicio y fin en variables de fecha
    Fecha_Inicial = DateSerial(2023, 1, 1)
    Fecha_Final = DateSerial(2023, 12, 31)
    
    'Verificar longitud de la cadena en TextBoxFEGA
    If Len(TextBoxFEGA.Value) > 10 Then
        TextBoxFEGA.Value = Mid(TextBoxFEGA.Value, 1, 10)
        MsgBox "La fecha esta completa"
    Else
        If Len(TextBoxFEGA.Value) = 2 Then
            TextBoxFEGA.Value = TextBoxFEGA.Value & "/"
        End If
    
        If Len(TextBoxFEGA.Value) = 5 Then
            TextBoxFEGA.Value = TextBoxFEGA.Value & "/23"
        End If
    End If
    
    'Verificar si la fecha ingresada está dentro del rango permitido
    If IsDate(TextBoxFEGA.Value) Then
        If CDate(TextBoxFEGA.Value) > Fecha_Inicial And CDate(TextBoxFEGA.Value) < Fecha_Final Then
            TextBoxDEGA.Enabled = True
            MsgBox "FECHA PERMITIDA"
        Else
            MsgBox "FECHA NO PERMITIDA"
            TextBoxFEGA.Value = ""
            TextBoxDEGA.Enabled = False
        End If
    End If
    
End Sub
    
Private Sub TextBoxFEGA_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    
    'Variable Bandera para verificar si se ha pulsado la tecla de retroceso (backspace)
    Dim Bandera As Boolean
    
    'Si la tecla pulsada es backspace, establecer la bandera en verdadero
    If KeyCode = 8 Then
        Bandera = True
    Else
        Bandera = False
    End If
    
End Sub

 

[Felixin76]

Buenas Nancy 

He probado el VB enviado y cuando intento introducir la fecha ,me sale la ventana emergent con"FECHA NO PERMITIDA "

y la macro se queda ahi 

He intentado modificar lagun rango para evitar eso y me sigue saliendo la ventana

seguro que es algo que se me escapa de las manos 

Sigo probando y trabajando en ello ,sobre  el tema de la activacion de la siguiente casilla si la fecha esta en rango 

Muchas gracias por vuestra colaboracion  y dedicacion

Saludos