FormatCurrency

[AndyGroom]

It's not a parameter that you can pass to it, but can you get FormatCurrency to format an amount in a different currency to your localisation setting? Or is there a different function that can be used (without writing one).

- Andy
___________________________________________________________________
If you think nobody cares you're alive, try missing a couple of mortgage payments

 

[HarleyQuinn]

You could use the Format() function, something like:

Format(23.32, "$##.##")

Hope this helps

HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http://lessthandot.com

 

[AndyGroom]

Thanks but I was hoping for something that can format a currency amount based on Windows' default currency formatting for a specific country.

- Andy
___________________________________________________________________
If you think nobody cares you're alive, try missing a couple of mortgage payments

 

[HarleyQuinn]

Sorry, when you said you wanted to format into a different currency format than your localisation settings I assumed that you wanted to ignore any system settings for currency formatting.

When you say:

default currency formatting for a specific country

Is this a country other than the country settings the PC is set up to use?

Could you give us an example of what you mean?


HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http://lessthandot.com

 

[AndyGroom]

Yes I'm doing a utility for an accounts package and I've added a droplist so that the user can choose the country with which they're trading.

Ideally I'd like to format any transactions with that country in the relevant way and rather than research currencies and countries (which I'm sure I could find on Wikipedia) I thought I could let Windows do the hard work and format it for me. After all it must have the defaults somewhere because it applies them when you change your localisation.

So, if the user chooses USA it would show $10.00, Euros for most European countries, Yen for China, Pounds for the UK and so on.

- Andy
___________________________________________________________________
If you think nobody cares you're alive, try missing a couple of mortgage payments

 

[HarleyQuinn]

OK, without writing your own, there's not a lot of scope to do what you want. However, if you did write your own, it might look something like this (including unicode msgbox support and OS check):On the form

Private Sub Form_Load()
  Dim sMsg As String
  sMsg = sMsg & FormatCurrencyByLCID("123.45", 1033) & " (U.S. Dollar)" & vbCrLf
  sMsg = sMsg & FormatCurrencyByLCID("123.45", 2057) & " (GB Pound)" & vbCrLf
  sMsg = sMsg & FormatCurrencyByLCID("123.45", 1046) & " (Brazil Real)" & vbCrLf
  sMsg = sMsg & FormatCurrencyByLCID("123.45", 2052) & " (Chinese)" & vbCrLf
  sMsg = sMsg & FormatCurrencyByLCID("123.45", 1025) & " (Arabic)" & vbCrLf
  sMsg = sMsg & FormatCurrencyByLCID("123.45", 1042) & " (Korean)" & vbCrLf
  MsgBox sMsg, , "FormatCurrencyByLCID"
End Sub

'Purpose: Unicode aware MsgBox
'Overrides Vb6 MsgBox. HelpFile/Context not supported
Function MsgBox(Prompt As String, _
  Optional Buttons As VbMsgBoxStyle = vbOKOnly, _
  Optional Title As String) As VbMsgBoxResult

  Dim WshShell As Object
  Set WshShell = CreateObject("WScript.Shell")
  MsgBox = WshShell.Popup(Prompt, 0&, Title, Buttons)
  Set WshShell = Nothing
End Function

In a module

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

As I didn't want to type out a full example myself (as I didn't have this in my code library) full credit for the above example goes to danaseaman.

Hope this is helpful

HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http://lessthandot.com

 

[strongm]

GetLocaleInfo API call may be your friend here

 

[AndyGroom]

Thanks, I'm sure I can pull it apart and find what I'm after!

- Andy
___________________________________________________________________
If you think nobody cares you're alive, try missing a couple of mortgage payments

 

[HarleyQuinn]

Actually, that is massively overkill (my post that is ), but still pretty useful.

If you want to bare bones this, you can just use GetCurrencyFormatW() API call.

Hope this helps



HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http://lessthandot.com

 

[HarleyQuinn]

Yeah, real bare bones (no checking of intalled locale etc.)

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 Const LOCALE_NOUSEROVERRIDE As Long = &H80000000

Private Sub Form_Load()

MsgBox GetCurrency(23.54, 1036) ' 1036 is the value for France

End Sub

Function GetCurrency(expression As Variant, LCID As Long) As String

    Dim ret As Long
 
    Dim stBuffer As String
    
    ret = GetCurrencyFormatW(LCID, LOCALE_NOUSEROVERRIDE, StrPtr(CStr(expression)), ByVal 0&, 0&, 0&)
    
    stBuffer = String$(ret, vbNullChar)
    
    ret = GetCurrencyFormatW(LCID, LOCALE_NOUSEROVERRIDE, StrPtr(CStr(expression)), ByVal 0&, StrPtr(stBuffer), Len(stBuffer))
    
    GetCurrency = stBuffer

End Function

The LCID values in Hex form can be obtained from here

Hope this helps

HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http://lessthandot.com

 

[strongm]

Hey HQ, aren't you supposed to be spending your time writing a FileSearch replacement? ;-)

 

[HarleyQuinn]

True, very true Mr Strong

I had my Dan Appleman book open for that so I thought I'd take a bit of a break, skip forward a few chapters and reply to Andy



HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http://lessthandot.com