Conflict: International xlDateOrder and Regional Date Order

[nilsenk]

Hello...

I must say I appreciate this forum immensely… most I have learned about VBA has come from this forum. One can find almost anything here, and until now I have not had the need to post any questions… The issue I am struggling with I have not found an answer for yet at any forums I have visited… I really hope someone here can help me…

The issue is a conflict that arises between the International property xlDateOrder and the date order defined in Regional & Language Options when a specific language is set… I have a code that detects the three different date order settings, listed below, attempting to determine the correct date format to use in my excel sheet. These are:

1. the date order returned by Application.International(xlDateOrder)
2. the date order returned by a API function GetSystemDefaultLCID (Regional System date in windows)
3. the date order returned by a API function GetUserDefaultLCID (Local user date in windows)

When I change the Regional and Language Options the Local User Date Format Order (bullet 3 above) seems to change, but the xlDateOrder (bullet 1 above) and the System date order (bullet 2 above) do not. But the strange thing is that the international property xlDateOrder sometimes change independently from the system date. This means that when I read xlDateOrder the return might be ‘0’ (MM/dd/yy short date order), but getting the system date format order with GetSystemDefaultLCID returns ‘1’ (dd/MM/yy short date order), as well as the local user date format order using GetUserDefaultLCID also is ‘1’. When this happens I am forced to input dates into excel cells in the format MM/dd/yy, otherwise a VALUE#! error occurs in the excel formulas I have. But if I type in this format, the date is displayed correctly as dd/MM/yy after exiting the cell.
This is very impractical for users, that they suddenly must change the way they type the dates into a cell.

So, one problem is that I cannot change the xlDateOrder parameter (it is read only) and it does neither change with the local user date format order (using Regional and Language Options) nor the system date format order.

Questions:
How can I assure that the date format order when entering a date into a cell is the same as the order it is displayed after the cell is exited?

Is there a way to change the international property xlDateOrder indirectly, or the format that is required when entering dates into a cell (which seems to be connected to this property)?

It is not an option to always force the display format according to the xlDateOrder parameter, since we use dd/MM/yy format in Norway, and this parameter keeps changing (probably due an application that is run on the company computers, which is administered in the US, thus forcing date format to MM/dd/yy)…

Below is a code that I have used to check the date format orders, and then attempt to set the system date format according to the local user date format, in the hope that the international property also may change. It does'nt work... Much of the code I have got from places on the web. The system date format is seemingly set (without error feedback), but the LOCALE_IDATE (representing date order) is not, and comes back with error.

If there is anyone out there that can help with this issue, I appreciate it grately...

Regards,
Knut

Code:

Public Const LOCALE_SSHORTDATE = &H1F           'short date format string
Public Const LOCALE_SDATE = &H1D                'date separator
Public Const HWND_BROADCAST As Long = &HFFFF&
Public Const WM_SETTINGCHANGE As Long = &H1A
Public Const LOCALE_IDATE = &H21                '0=M–D–Y, 1=D–M–Yr, 2=Y–M–D

'retrieves the local user default locale identifier
Public Declare Function GetUserDefaultLCID _
    Lib "kernel32" () As Long

'retrieves the system default locale identifier
Public Declare Function GetSystemDefaultLCID _
    Lib "kernel32" () As Long
 
Public 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

Public Declare Function SetLocaleInfo Lib _
    "kernel32" Alias "SetLocaleInfoA" ( _
    ByVal Locale As Long, _
    ByVal LCType As Long, _
    ByVal lpLCData As String) As Boolean

Public Declare Function PostMessage Lib "user32" _
    Alias "PostMessageA" _
    (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
    


Public Function GetUserLocaleInfo(ByVal dwLocaleID As Long, _
                                  ByVal dwLCType As Long) As String

   Dim sReturn As String
   Dim r As Long

  'call the function passing the Locale type
  'variable to retrieve the required size of
  'the string buffer needed
   r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
    
  'if successful..
   If r Then
    
     'pad the buffer with spaces
      sReturn = Space$(r)
       
     'and call again passing the buffer
      r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
     
     'if successful (r > 0)
      If r Then
      
        'r holds the size of the string
        'including the terminating null
         GetUserLocaleInfo = Left$(sReturn, r - 1)
      
      End If
   
   End If
End Function
    
Public Function GetSystemLocaleInfo(ByVal dwLocaleID As Long, _
                                    ByVal dwLCType As Long) As String

   Dim sReturn As String
   Dim r As Long

  'call the function passing the Locale type
  'variable to retrieve the required size of
  'the string buffer needed
   r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
    
  'if successful..
   If r Then
    
     'pad the buffer with spaces
      sReturn = Space$(r)
       
     'and call again passing the buffer
      r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
     
     'if successful (r > 0)
      If r Then
      
        'r holds the size of the string
        'including the terminating null
         GetSystemLocaleInfo = Left$(sReturn, r - 1)
      
      End If
   
   End If
End Function

Public Function CheckLocaleDateFormatOrder() As Long
    Dim LCID As Long
    
    LCID = GetUserDefaultLCID()
    'Get Local User date format
    CheckLocaleDateFormatOrder = GetUserLocaleInfo(LCID, LOCALE_IDATE)
End Function


Public Function CheckSystemDateFormatOrder() As Long
    Dim LCID As Long
    
    LCID = GetSystemDefaultLCID()
    'Get Local User date format
    CheckSystemDateFormatOrder = GetSystemLocaleInfo(LCID, LOCALE_IDATE)
End Function

Public Sub SetSystemDateFormat()
    Dim S As Worksheet
    Set S = Worksheets("Setup")
    Dim Y, Z, IntDateOrder As Long
    Dim LocaleDate As String
    Dim LCIDSystem, LCIDlocale, lRet As Long
    
    'Check locale regional date format order
    Y = CheckLocaleDateFormatOrder
    'Check System regional date format order
    Z = CheckSystemDateFormatOrder
    'Check international date format order
    IntDateOrder = Application.International(xlDateOrder)
    
    MsgBox "Before setting system date format:" & vbNewLine & _
           "International Date Order = " & vbTab & IntDateOrder & vbNewLine & _
           "System Date Format Order = " & vbTab & Z & vbNewLine & _
           "Locale Date Format Order = " & vbTab & Y 
    
    LCIDlocale = GetUserDefaultLCID()
    'Get Local User date format
    LocaleDate = GetUserLocaleInfo(LCIDlocale, LOCALE_SSHORTDATE)
    
    LCIDSystem = GetSystemDefaultLCID()

    'set the new system date format according to local date format
    If SetLocaleInfo(LCIDSystem, LOCALE_SSHORTDATE, LocaleDate) = False Then
       'Handle error
        MsgBox "Failed to Force System Date Format to " & LocaleDate, vbExclamation
        Exit Sub
    End If

    'set the new system date format Order according to local date format order
    If SetLocaleInfo(LCIDSystem, LOCALE_IDATE, CStr(Y)) = False Then
       ' Handle error, possibly by writing it
        MsgBox "Failed to Force System Date Format Order to " & Y, vbExclamation
        Exit Sub
    End If
    
    'Notify system of settings change
    lRet = PostMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0&, ByVal 0&)
    
    'Check locale regional date format order
    Y = CheckLocaleDateFormatOrder
    'Check System regional date format order
    Z = CheckSystemDateFormatOrder
    'Check international date format order
    IntDateOrder = Application.International(xlDateOrder)
    
    MsgBox "After setting system date format:" & vbNewLine & _
           "International Date Order = " & vbTab & IntDateOrder & vbNewLine & _
           "System Date Format Order = " & vbTab & Z & vbNewLine & _
           "Locale Date Format Order = " & vbTab & Y 
    
End Sub