help to test a code

[LeandroA]

Hello, I would like to verify that this code works well in any configuration, especially in the US, what the code does is to be able to change the date in a textbox with the up and down arrows, depending on where the cursor is positioned, it would change the day/month/year, here in South America we use the dd/mm/yy format but I understand that in other countries that order can change, for example in the US they use mm/dd/yy

just add a textbox to a form with the following code and with the keyboard arrows up down change the date and let me know if there is something strange. Thank you.

Option Explicit
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long

Const LOCALE_SDATE = &H1D
Const LOCALE_SSHORTDATE = &H1F

Dim sDateDiv As String
Dim sShortDate As String

Private Sub Form_Load()
    sDateDiv = fGetLocaleInfo(LOCALE_SDATE)
    sShortDate = fGetLocaleInfo(LOCALE_SSHORTDATE)
    Text1.Text = Format$(Date, sShortDate)
End Sub


Private Function fGetLocaleInfo(Valor As Long) As String
   Dim Simbolo As String
   Dim r1 As Long
   Dim r2 As Long
   Dim p As Integer
   Dim Locale As Long
     
   Locale = GetUserDefaultLCID()
   r1 = GetLocaleInfo(Locale, Valor, vbNullString, 0)
   Simbolo = String$(r1, 0)
   r2 = GetLocaleInfo(Locale, Valor, Simbolo, r1)
   p = InStr(Simbolo, Chr$(0))
     
   If p > 0 Then fGetLocaleInfo = Left$(Simbolo, p - 1)
 
     
End Function

Private Sub Text1_GotFocus()
    AutoSelDatePart
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
   'On Error Resume Next
    Dim Val As Long
    Dim Sel As Long
    Dim TheDate As Date
    Dim Part1() As String
    Dim Part2() As String
    Dim i As Long
    
    If KeyCode = vbKeyUp Then
       Val = 1
       KeyCode = 0
    ElseIf KeyCode = vbKeyDown Then
       Val = -1
       KeyCode = 0
    ElseIf (KeyCode = vbKeyLeft) Then
        KeyCode = 0
        If Text1.SelStart > 0 Then Text1.SelStart = Text1.SelStart - 2
        AutoSelDatePart
        Exit Sub
    ElseIf KeyCode = vbKeyRight Then
        KeyCode = 0
        Text1.SelStart = Text1.SelStart + Text1.SelLength + 1
        AutoSelDatePart
        Exit Sub
       
    Else
       Exit Sub
    End If
    
    Part1 = Split(Text1.Text, sDateDiv)
    Part2 = Split(sShortDate, sDateDiv)
    For i = 0 To UBound(Part2)
        If InStr(LCase(Part2(i)), "y") Then Part2(i) = "yyyy"
    Next
    Sel = Text1.SelStart
    Select Case Text1.SelStart
       Case Is < Len(Part1(0)) + 1
          TheDate = DateAdd(Part2(0), Val, Text1.Text)
       Case Is < Len(Part1(0) & Part1(1)) + 2
          TheDate = DateAdd(Part2(1), Val, Text1.Text)
       Case Else
          TheDate = DateAdd("yyyy", Val, Text1.Text)
    End Select
    Text1.Text = Format$(TheDate, sShortDate)
    Text1.SelStart = Sel
    AutoSelDatePart
End Sub

Private Sub AutoSelDatePart()
    Dim Sel As Long
    Dim Part1() As String
    
    If Len(Text1.Text) < Len(sShortDate) Then Exit Sub
    
    Part1 = Split(Text1.Text, sDateDiv)
    
    Sel = Text1.SelStart

    Select Case Sel
        Case Is < Len(Part1(0)) + 1
            Text1.SelStart = 0
            Text1.SelLength = Len(Part1(0))
        Case Is < Len(Part1(0) & Part1(1)) + 2
            Text1.SelStart = Len(Part1(0)) + 1
            Text1.SelLength = Len(Part1(1))
        Case Else
            If UBound(Part1) < 2 Then
                Text1.SelStart = 0
                Text1.SelLength = Len(Part1(0))
            Else
                Text1.SelStart = Len(Text1.Text) - Len(Part1(2))
                Text1.SelLength = Len(Part1(2))
            End If
    End Select
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    AutoSelDatePart
End Sub