Uso Userform para alimentar una base de datos con fechas pero las registra invirtiendo el formato

Tengo una macro cuyo código es el siguiente:

Private Sub Userform_Initialize()
Sheets("Listas").Select
Range("A1").Select
While ActiveCell <> ""
ComboBox1.AddItem ActiveCell
ActiveCell.Offset(1, 0).Select
Wend
Sheets("INICIO").Select
End Sub

Private Sub CommandButton1_Click()
Dim fechaActual As Date
fechaActual = Date
TextBox1.Value = fechaActual
End Sub
Private Sub CommandButton3_Click()
Unload Me
REGISTRO.Show
End Sub
Private Sub CommandButton4_Click()
Unload Me
End Sub
Private Sub CommandButton2_Click()
        Sheets("Registro").Select
        Range("A2").Select
        Do While ActiveCell <> Empty
        ActiveCell.Offset(1, 0).Select
        Loop
        ActiveCell.Value = Me.ComboBox1.Value
        Range("B2").Select
        Do While ActiveCell <> Empty
        ActiveCell.Offset(1, 0).Select
        Loop
        ActiveCell.Value = Me.TextBox1.Value
        Range("c2").Select
        Do While ActiveCell <> Empty
        ActiveCell.Offset(1, 0).Select
        Loop
        ActiveCell.Value = Me.TextBox2.Value
        Range("d2").Select
        Do While ActiveCell <> Empty
        ActiveCell.Offset(1, 0).Select
        Loop
        ActiveCell.Value = Me.TextBox3.Value
        Range("e2").Select
        Do While ActiveCell <> Empty
        ActiveCell.Offset(1, 0).Select
        Loop
        ActiveCell.Value = Me.TextBox4.Value
        Range("f2").Select
        Do While ActiveCell <> Empty
        ActiveCell.Offset(1, 0).Select
        Loop
        ActiveCell.Value = Me.TextBox5.Value
        Range("g2").Select
        Do While ActiveCell <> Empty
        ActiveCell.Offset(1, 0).Select
        Loop
        ActiveCell.Value = Me.TextBox6.Value
        Range("h2").Select
        Do While ActiveCell <> Empty
        ActiveCell.Offset(1, 0).Select
        Loop
        ActiveCell.Value = Me.TextBox7.Value
        Sheets("INICIO").Select
      End Sub

En definitiva lo que hace es copiar datos que introduzco en el userform llamado "registo" a otra hoja llamada "Registro" dentro del mismo libro. Mi problema es con el TexBox1 en el que introduzco una fecha en formato dd/mm/yyyy pero al copiarme este dato a la hoja registro me lo almacena con fecha en formato mm/dd/yyyy.

1 Respuesta

Respuesta
1

Prueba con lo siguiente:

Cambia en tu macro esto:

ActiveCell.Value = Me.TextBox1.Value

Por esto:

ActiveCell.Value = CDate(Me.TextBox1.Value)

Saludos.Dante Amor

Si es lo que necesitas.

Hola Dante!

La solución a la pregunta formulada es perfecta, ahora el problema es otro.

En ese mismo libro tengo una macro para consultar información que queda registrada a través de la Macro "Registro".. Dicha macro m, la habías pasado tu, pero ahora con la nueva modificación para el formato de la fecha no me funciona.(Te envío el archivo por mail)

Saludos,

Cristina

Te anexo la macro para consulta.

Private Sub CommandButton1_Click()
'Por.Dante Amor
    Dim fec1 As Date, fec2 As Date
    Set h1 = Sheets("Registro")
    Set h2 = Sheets("Resultado")
    h2.Cells.Clear
    '
    If TextBox1 = "" Or Not IsDate(TextBox1) Then
        MsgBox "Fecha inicial no válida"
        TextBox1.SetFocus
        Exit Sub
    End If
    If TextBox2 = "" Or Not IsDate(TextBox2) Then
        MsgBox "Fecha final no válida"
        TextBox2.SetFocus
        Exit Sub
    End If
    fec1 = Format(TextBox1, "dd/mm/yyyy")
    fec2 = Format(TextBox2, "dd/mm/yyyy")
    If ComboBox1 = "" Then
        modelo = "*"
    Else
        modelo = ComboBox1
    End If
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    h1.Range("A2:H" & u).AutoFilter Field:=1, Criteria1:=modelo
    h1.Range("A2:H" & u).AutoFilter Field:=2, _
        Criteria1:=">=" & Format(TextBox1, "mm/dd/yyyy"), Operator:=xlAnd, _
        Criteria2:="<=" & Format(TextBox2, "mm/dd/yyyy")
    '
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    If u = 2 Then
        MsgBox "No éxiste información con esos criterios", vbInformation
        Exit Sub
    End If
    h1.Rows(2 & ":" & u).Copy h2.Rows(2)
    h1.Select
    Sheets("Resultado").Select
End Sub

No olvides cambiar la valoración

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas