Option Explicit
Private Const LCID_INSTALLED = &H1
Private Const LCID_SUPPORTED As Long = &H2
Private Const LOCALE_NOUSEROVERRIDE As Long = &H80000000 ' OR in to avoid user override
Private Declare Function GetCurrencyFormatA Lib "kernel32" (ByVal locale As Long, ByVal dwFlags As Long, ByVal lpValue As String, lpFormat As Any, ByVal lpCurrencyStr As String, ByVal cchCurrency As Long) As Long
Private Declare Function GetCurrencyFormatW Lib "kernel32" (ByVal locale As Long, ByVal dwFlags As Long, ByVal lpValue As Long, lpFormat As Any, ByVal lpCurrencyStr As Long, ByVal cchCurrency As Long) As Long
Private Declare Function IsValidLocale Lib "kernel32" (ByVal locale As Long, ByVal dwFlags As Long) As Boolean
Private Declare Function IsWindowUnicode Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
Function FormatCurrencyByLCID(Expression As Variant, Optional locale As Long = -1) As String
'Expression may be:
' characters '0' through '9'
' One decimal point (dot) if the number is a floating-point value
' A minus sign in the first character position if the number is a negative value
' All other characters are invalid.
' The function returns an error if the string pointed to by lpValue deviates from these rules.
Dim stBuffer As String
Dim cch As Long
If (IsValidLocale(locale, LCID_INSTALLED) = 0) Then
FormatCurrencyByLCID = FormatCurrency(Expression)
Else
If IsNT Then
cch = GetCurrencyFormatW(locale, LOCALE_NOUSEROVERRIDE, StrPtr(CStr(Expression)), ByVal 0&, 0&, 0&)
If cch > 0 Then
stBuffer = String$(cch, vbNullChar)
If GetCurrencyFormatW(locale, LOCALE_NOUSEROVERRIDE, StrPtr(CStr(Expression)), ByVal 0&, StrPtr(stBuffer), Len(stBuffer)) > 0 Then
FormatCurrencyByLCID = StripNull(stBuffer)
Else
Err.Raise vbObjectError + 3000, "modCurrency", "Failed GetCurrencyFormat call, GetLastError returns: " & Err.LastDllError
End If
End If
Else
cch = GetCurrencyFormatA(locale, LOCALE_NOUSEROVERRIDE, CStr(Expression), ByVal 0&, vbNullString, 0&)
If cch > 0 Then
stBuffer = String$(cch, vbNullChar)
If GetCurrencyFormatA(locale, LOCALE_NOUSEROVERRIDE, CStr(Expression), ByVal 0&, stBuffer, Len(stBuffer)) > 0 Then
FormatCurrencyByLCID = StripNull(stBuffer)
Else
Err.Raise vbObjectError + 3000, "modCurrency", "Failed GetCurrencyFormat call, GetLastError returns: " & Err.LastDllError
End If
End If
End If
End If
End Function
Private Function IsNT() As Boolean
IsNT = IsWindowUnicode(GetDesktopWindow)
End Function
Public Function StripNull(StrIn As String) As String
Dim nul As Long
nul = InStr(StrIn, vbNullChar & vbNullChar)
If (nul) Then
StripNull = Left$(StrIn, nul - 1)
Else
nul = InStr(StrIn, vbNullChar)
If (nul) Then
StripNull = Left$(StrIn, nul - 1)
Else
StripNull = Trim$(StrIn)
End If
End If
End Function