Determine system currency symbol

[gmaxey]

I need to determine the Asc value of the system currency symbol using an AutoNew macro in Word. I've managed to do so using a Rube Goldberg method shown below. Is there a more direct or "elegant" method? Maybe using as API? Thanks.

Sub AutoNew()
Dim strTest As String
Dim strSymbolAsc As String
strTest = 1
strSymbolAsc = Asc(Left(FormatCurrency(strTest), 1))
Debug.Print strSymbolAsc
'WriteValue "System Currency", strSymbolAsc
End Sub

[Paul_Hossler]

Try


Sub drv()
MsgBox Application.International(wdCurrencyCode)
End Sub


Paul

[gmaxey]

Paul,

Thanks. I was just coming back to post that I had found an answer (and yours certainly answers the specific question asked very well).

Actually though I need that plus a few ohter things. I was already using an API call to get country information but was too dense to realize I could use the same thing to get other data as well:

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
Public Const LOCALE_USER_DEFAULT = &H400
Public Const LOCALE_SDECIMAL As Long = &HE
Public Const LOCALE_ILDATE As Long = &H22
Public Const LOCALE_ICOUNTRY As Long = &H5
Public Const LOCALE_SCURRENCY As Long = &H14
Public Const LOCALE_ICURRENCY As Long = &H1B
Public Const LOCALE_SENGCOUNTRY = &H1002 ' English name of country
Public Const LOCALE_SENGLANGUAGE = &H1001 ' English name of language
Public Const LOCALE_SNATIVELANGNAME = &H4 ' native name of language
Public Const LOCALE_SNATIVECTRYNAME = &H8 ' native name of country
Public Function GetInfo(ByVal lInfo As Long) As String
Dim Buffer As String
Dim Ret As String
Buffer = String$(256, 0)
Ret = GetLocaleInfo(LOCALE_USER_DEFAULT, lInfo, Buffer, Len(Buffer))
If Ret > 0 Then
GetInfo = Left$(Buffer, Ret - 1)
Else
GetInfo = ""
End If
lbl_Exit:
Exit Function
End Function

[Paul_Hossler]

Excel has a better set of .International constants than Word does (for some reason known only to Microsoft)

I's like to add your

Public Function GetInfo(ByVal lInfo As Long) As String


to my little toolbox, so are that any more constants that return information?

Paul

[gmaxey]

Paul,

The following are the ones that I have managed to find and define:

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
'See http://msdn.microsoft.com/en-us/library/dd373739(v=VS.85).aspx for meaning of various constants.
Public Const LOCALE_USER_DEFAULT As Long = &H400
Public Const LOCALE_SENGLANGUAGE As Long = &H1001 ' English name of language
Public Const LOCALE_SENGCOUNTRY As Long = &H1002 ' English name of country
Public Const LOCALE_ILANGUAGE As Long = &H1
Public Const LOCALE_SLANGUAGE As Long = &H2
Public Const LOCALE_SABBREVLANGNAME As Long = &H3
Public Const LOCALE_SNATIVELANGNAME As Long = &H4 ' native name of language
Public Const LOCALE_ICOUNTRY As Long = &H5
Public Const LOCALE_SCOUNTRY As Long = &H6
Public Const LOCALE_SABBREVCTRYNAME As Long = &H7
Public Const LOCALE_SNATIVECTRYNAME As Long = &H8 ' native name of country
Public Const LOCALE_IDEFAULTLANGUAGE As Long = &H9
Public Const LOCALE_IDEFAULTCOUNTRY As Long = &HA
Public Const LOCALE_IDEFAULTCODEPAGE As Long = &HB
Public Const LOCALE_SLIST = &HC
Public Const LOCALE_IMEASURE As Long = &HD
Public Const LOCALE_SDECIMAL As Long = &HE
Public Const LOCALE_STHOUSAND As Long = &HF
Public Const LOCALE_SGROUPING As Long = &H10
Public Const LOCALE_IDIGITS As Long = &H11
Public Const LOCALE_ILZERO As Long = &H12
Public Const LOCALE_SNATIVEDIGITS As Long = &H13
Public Const LOCALE_SCURRENCY As Long = &H14 'local currency symbol
Public Const LOCALE_SINTLSYMBOL As Long = &H15 'intl symbol
Public Const LOCALE_SMONDECIMALSEP As Long = &H16 'decimal separator
Public Const LOCALE_SMONTHOUSANDSEP As Long = &H17 'thousand separator
Public Const LOCALE_SMONGROUPING As Long = &H18 'grouping
Public Const LOCALE_ICURRDIGITS As Long = &H19 '# local digits
Public Const LOCALE_IINTLCURRDIGITS As Long = &H1A '# intl digits
Public Const LOCALE_ICURRENCY As Long = &H1B 'pos currency mode
Public Const LOCALE_INEGCURR As Long = &H1C 'neg currency mode
Public Const LOCALE_SDATE As Long = &H1D
Public Const LOCALE_STIME As Long = &H1E
Public Const LOCALE_SSHORTDATE As Long = &H1F
Public Const LOCALE_SLONGDATE As Long = &H20
Public Const LOCALE_IDATE As Long = &H21
Public Const LOCALE_ILDATE As Long = &H22
Public Const LOCALE_ITIME As Long = &H23
Public Const LOCALE_ICENTURY As Long = &H24
Public Const LOCALE_ITLZERO As Long = &H25
Public Const LOCALE_IDAYLZERO As Long = &H26
Public Const LOCALE_IMONLZERO As Long = &H27
Public Const LOCALE_S1159 As Long = &H28
Public Const LOCALE_S2359 As Long = &H29
Public Const LOCALE_SDAYNAME1 As Long = &H2A 'long name for Monday
Public Const LOCALE_SDAYNAME2 As Long = &H2B 'long name for Tuesday
Public Const LOCALE_SDAYNAME3 As Long = &H2C 'long name for Wednesday
Public Const LOCALE_SDAYNAME4 As Long = &H2D 'long name for Thursday
Public Const LOCALE_SDAYNAME5 As Long = &H2E 'long name for Friday
Public Const LOCALE_SDAYNAME6 As Long = &H2F 'long name for Saturday
Public Const LOCALE_SDAYNAME7 As Long = &H30 'long name for Sunday
Public Const LOCALE_SABBREVDAYNAME1 As Long = &H31 'short name for Monday
Public Const LOCALE_SABBREVDAYNAME2 As Long = &H32 'short name for Tuesday
Public Const LOCALE_SABBREVDAYNAME3 As Long = &H33 'short name for Wednesday
Public Const LOCALE_SABBREVDAYNAME4 As Long = &H34 'short name for Thursday
Public Const LOCALE_SABBREVDAYNAME5 As Long = &H35 'short name for Friday
Public Const LOCALE_SABBREVDAYNAME6 As Long = &H36 'short name for Saturday
Public Const LOCALE_SABBREVDAYNAME7 As Long = &H37 'short name for Sunday
Public Const LOCALE_SMONTHNAME1 As Long = &H38
Public Const LOCALE_SMONTHNAME2 As Long = &H39
Public Const LOCALE_SMONTHNAME3 As Long = &H3A
Public Const LOCALE_SMONTHNAME4 As Long = &H3B
Public Const LOCALE_SMONTHNAME5 As Long = &H3C
Public Const LOCALE_SMONTHNAME6 As Long = &H3D
Public Const LOCALE_SMONTHNAME7 As Long = &H3E
Public Const LOCALE_SMONTHNAME8 As Long = &H3F
Public Const LOCALE_SMONTHNAME9 As Long = &H40
Public Const LOCALE_SMONTHNAME10 As Long = &H41
Public Const LOCALE_SMONTHNAME11 As Long = &H42
Public Const LOCALE_SMONTHNAME12 As Long = &H43
Public Const LOCALE_SABBREVMONTHNAME1 As Long = &H44
Public Const LOCALE_SABBREVMONTHNAME2 As Long = &H45
Public Const LOCALE_SABBREVMONTHNAME3 As Long = &H46
Public Const LOCALE_SABBREVMONTHNAME4 As Long = &H47
Public Const LOCALE_SABBREVMONTHNAME5 As Long = &H48
Public Const LOCALE_SABBREVMONTHNAME6 As Long = &H49
Public Const LOCALE_SABBREVMONTHNAME7 As Long = &H4A
Public Const LOCALE_SABBREVMONTHNAME8 As Long = &H4B
Public Const LOCALE_SABBREVMONTHNAME9 As Long = &H4C
Public Const LOCALE_SABBREVMONTHNAME10 As Long = &H4D
Public Const LOCALE_SABBREVMONTHNAME11 As Long = &H4E
Public Const LOCALE_SABBREVMONTHNAME12 As Long = &H4F
Public Const LOCALE_SPOSITIVESIGN As Long = &H50
Public Const LOCALE_SNEGATIVESIGN As Long = &H51
Public Const LOCALE_IPOSSIGNPOSN As Long = &H52 'pos sign position
Public Const LOCALE_INEGSIGNPOSN As Long = &H53 'neg sign position
Public Const LOCALE_IPOSSYMPRECEDES As Long = &H54 'mon sym precedes pos amt
Public Const LOCALE_IPOSSEPBYSPACE As Long = &H55 'mon sym sep by space from pos amt
Public Const LOCALE_INEGSYMPRECEDES As Long = &H56 'mon sym precedes neg amt
Public Const LOCALE_INEGSEPBYSPACE As Long = &H57 'mon sym sep by space from neg amt
Public Const LOCALE_FONTSIGNATURE As Long = &H58
Public Const LOCALE_SISO639LANGNAME As Long = &H59
Public Const LOCALE_SISO3166CTRYNAME As Long = &H5A
Public Const LOCALE_IGEOID As Long = &H5B
Public Const LOCALE_SNAME As Long = &H5C
Public Const LOCALE_SDURATION As Long = &H5D
Public Const LOCALE_SKEYBOARDSTOINSTALL = &H5E
'**
Public Const LOCALE_SSHORTESTDAYNAME1 As Long = &H60
Public Const LOCALE_SSHORTESTDAYNAME2 As Long = &H61
Public Const LOCALE_SSHORTESTDAYNAME3 As Long = &H62
Public Const LOCALE_SSHORTESTDAYNAME4 As Long = &H63
Public Const LOCALE_SSHORTESTDAYNAME5 As Long = &H64
Public Const LOCALE_SSHORTESTDAYNAME6 As Long = &H65
Public Const LOCALE_SSHORTESTDAYNAME7 As Long = &H66
Public Const LOCALE_SISO639LANGNAME2 As Long = &H67
Public Const LOCALE_SISO3166CTRYNAME2 As Long = &H68
Public Const LOCALE_SNAN As Long = &H69
Public Const LOCALE_SPOSINFINITY As Long = &H6A
Public Const LOCALE_SNEGINFINITY As Long = &H6B
Public Const LOCALE_SSCRIPTS As Long = &H6C
Public Const LOCALE_SPARENT As Long = &H6D
Public Const LOCALE_SCONSOLEFALLBACKNAME As Long = &H6E
'**
Public Const LOCALE_IREADINGLAYOUT As Long = &H70
Public Const LOCALE_INEUTRAL As Long = &H71
'**
Public Const LOCALE_INEGATIVEPERCENT As Long = &H74
Public Const LOCALE_IPOSITIVEPERCENT As Long = &H75
Public Const LOCALE_SPERCENT As Long = &H76
Public Const LOCALE_SPERMILLE As Long = &H77
Public Const LOCALE_SMONTHDAY As Long = &H78
Public Const LOCALE_SSHORTTIME As Long = &H79
Public Const LOCALE_SOPENTYPELANGUAGETAG As Long = &H7A
Public Const LOCALE_SSORTLOCALE As Long = &H7B
Public Const LOCALE_STIMEFORMAT As Long = &H1003
Public Const LOCALE_IDEFAULTANSICODEPAGE As Long = &H1004
Public Const LOCALE_ITIMEMARKPOSN As Long = &H1005
Public Const LOCALE_SYEARMONTH As Long = &H1006
Public Const LOCALE_SENGCURRNAME As Long = &H1007 'english name of currency
Public Const LOCALE_SNATIVECURRNAME As Long = &H1008 'native name of currency
Public Const LOCALE_ICALENDARTYPE As Long = &H1009
Public Const LOCALE_IPAPERSIZE As Long = &H100A
Public Const LOCALE_IOPTIONALCALENDAR As Long = &H100B
Public Const LOCALE_IFIRSTDAYOFWEEK As Long = &H100C
Public Const LOCALE_IFIRSTWEEKOFYEAR As Long = &H100D
Public Const LOCALE_SMONTHNAME13 As Long = &H100E
Public Const LOCALE_SABBREVMONTHNAME13 As Long = &H100F
Public Const LOCALE_INEGNUMBER As Long = &H1010
Public Const LOCALE_IDEFAULTMACCODEPAGE As Long = &H1011
Public Const LOCALE_IDEFAULTEBCDICCODEPAGE As Long = &H1012
Public Const LOCALE_SSORTNAME As Long = &H1013
Public Const LOCALE_IDIGITSUBSTITUTION As Long = &H1014
Public Function GetInfo(ByVal lInfo As Long) As String
Dim Buffer As String
Dim Ret As String
Buffer = String$(256, 0)
Ret = GetLocaleInfo(LOCALE_USER_DEFAULT, lInfo, Buffer, Len(Buffer))
If Ret > 0 Then
GetInfo = Left$(Buffer, Ret - 1)
Else
GetInfo = ""
End If
lbl_Exit:
Exit Function
End Function
Sub Test()
MsgBox GetInfo(LOCALE_SCURRENCY)
End Sub

[Paul_Hossler]

Many thanks for the constants and esp. the link

I was experimenting with some of the constants that "could" have helped me out on a little project,s, but kept getting blanks returned. Until I read the fine print that they were Win7 or later

The one that I didn't see was a formatted Local Currency string that I could use for Format (...)

In the US, it'd be something like "$#,##0.00;($#,##0.00);$0.00"

Paul

[gmaxey]

Paul,

I don't think there is one that returns the complete FormatCurrency string. This is what I am using as I think "standard" is going to use the local decimal and grouping string:

Sub Test()
MsgBox CustFormatCurrency("1")
MsgBox CustFormatCurrency("-1")
MsgBox CustFormatCurrency("(1)")
MsgBox CustFormatCurrency("1000")
MsgBox CustFormatCurrency("-1000")
MsgBox CustFormatCurrency("(1000)")
End Sub
Function CustFormatCurrency(ByRef pStr As String) As String
Dim strCS As String
Dim i As Long
strCS = GetInfo(LOCALE_SCURRENCY)
CustFormatCurrency = Format(pStr, "Standard")
If IsNumeric(CustFormatCurrency) Then
If InStr(CustFormatCurrency, "-") > 0 Then
CustFormatCurrency = Replace(CustFormatCurrency, "-", "")
CustFormatCurrency = "(" & CustFormatCurrency & ")"
End If
Select Case GetInfo(LOCALE_ICURRENCY)
Case 0
CustFormatCurrency = strCS & CustFormatCurrency
Case 1
CustFormatCurrency = CustFormatCurrency & strCS
Case 2
CustFormatCurrency = strCS & " " & CustFormatCurrency
Case 3
CustFormatCurrency = CustFormatCurrency & " " & strCS
End Select
Else
CustFormatCurrency = ""
End If
End Function

[Paul_Hossler]

I've had problems with 'Standard' when I changed my locale in Windows Regional Settings, so I'm not sure how trustworthy it is

I did expand on your idea and used your link to do a NumberFormat-type function that returns a formatting string.

So far, it seems to work, but I'm not sure about the LOCALE_SGROUPING formats. I think after I understand it, it will need to be incorporated into the sNumber = line some how

Paul


Option Explicit
Sub drv()
Dim s As String

s = GetCurrencyFormat

MsgBox Format(1, s)
MsgBox Format(-1, s)
MsgBox Format(1.23, s)
MsgBox Format(123456.89, s)
MsgBox Format(-12345678.99, s)
MsgBox Format(543.21, s)
End Sub

Function GetCurrencyFormat() As String
Dim sCurrencySymbol As String
Dim sNumberFormat As String, sNumber As String

sCurrencySymbol = GetInfo(LOCALE_SCURRENCY)

sNumber = "#" & GetInfo(LOCALE_STHOUSAND) & "##0" & GetInfo(LOCALE_SDECIMAL) & Left("000000000000", CLng(GetInfo(LOCALE_ICURRDIGITS)))
Select Case GetInfo(LOCALE_ICURRENCY)

Case "0" 'Prefix, no separation, for example, $1.1
sNumberFormat = sCurrencySymbol & sNumber
Case "1" 'Suffix, no separation, for example, 1.1$
sNumberFormat = sNumber & sCurrencySymbol
Case "2" 'Prefix, 1-character separation, for example, $ 1.1
sNumberFormat = sCurrencySymbol & " " & sNumber
Case "3" 'Suffix, 1-character separation, for example, 1.1 $
sNumberFormat = sNumber & " " & sCurrencySymbol
End Select

sNumberFormat = sNumberFormat & ";"

Select Case GetInfo(LOCALE_INEGCURR)

Case "0" 'Left parenthesis, monetary symbol, number, right parenthesis; for example, ($1.1)
sNumberFormat = sNumberFormat & "(" & sCurrencySymbol & sNumber & ")"
Case "1" 'Negative sign, monetary symbol, number; for example, -$1.1
sNumberFormat = "-" & sCurrencySymbol & sNumber
Case "2" 'Monetary symbol, negative sign, number; for example, $-1.1
sNumberFormat = sCurrencySymbol & "-" & sNumber
Case "3" 'Monetary symbol, number, negative sign; for example, $1.1-
sNumberFormat = sCurrencySymbol & sNumber & "-"
Case "4" 'Left parenthesis, number, monetary symbol, right parenthesis; for example, (1.1$)"
sNumberFormat = sNumberFormat & "(" & sNumber & sCurrencySymbol & ")"
Case "5" 'Negative sign, number, monetary symbol; for example, -1.1$
sNumberFormat = sNumberFormat & "-" & sNumber & sCurrencySymbol
Case "6" 'Number, negative sign, monetary symbol; for example, 1.1-$
sNumberFormat = sNumberFormat & sNumber & "-" & sCurrencySymbol
Case "7" 'Number, monetary symbol, negative sign; for example, 1.1$-"
sNumberFormat = sNumberFormat & sNumber & sCurrencySymbol & "-"
Case "8" 'Negative sign, number, space, monetary symbol (like #5, but with a space before the monetary symbol); for example, -1.1 $
sNumberFormat = sNumberFormat & "-" & sNumber & " " & sCurrencySymbol
Case "9" 'Negative sign, monetary symbol, space, number (like #1, but with a space after the monetary symbol); for example, -$ 1.1
sNumberFormat = "-" & sCurrencySymbol & " " & sNumber
Case "10" 'Number, space, monetary symbol, negative sign (like #7, but with a space before the monetary symbol); for example, 1.1 $-
sNumberFormat = sNumberFormat & sNumber & " " & sCurrencySymbol & "-"
Case "11" 'Monetary symbol, space, number, negative sign (like #3, but with a space after the monetary symbol); for example, $ 1.1-
sNumberFormat = sCurrencySymbol & " " & sNumber & "-"
Case "12" 'Monetary symbol, space, negative sign, number (like #2, but with a space after the monetary symbol); for example, $ -1.1
sNumberFormat = sCurrencySymbol & " " & "-" & sNumber
Case "13" 'Number, negative sign, space, monetary symbol (like #6, but with a space before the monetary symbol); for example, 1.1- $"
sNumberFormat = sNumberFormat & sNumber & "-" & " " & sCurrencySymbol
Case "14" 'Left parenthesis, monetary symbol, space, number, right parenthesis (like #0, but with a space after the monetary symbol); for example, ($ 1.1)
sNumberFormat = sNumberFormat & "(" & sCurrencySymbol & " " & sNumber & ")"
Case "15" 'Left parenthesis, number, space, monetary symbol, right parenthesis (like #4, but with a space before the monetary symbol); for example, (1.1 $)
sNumberFormat = sNumberFormat & "(" & sNumber & " " & sCurrencySymbol & ")"
End Select

GetCurrencyFormat = sNumberFormat
End Function

[gmaxey]

Paul,

Good job! I just stumbled on most of that informtion. Understanding all or part of is may be something very illusive for me :-(

Please post back any changes or improvements that you make.

[Paul_Hossler]

Thanks

1. I left the "sNumberFormat & " off of negative cases 1,2,3

2. The Grouping is still under work, and I don't know to sort that out yet

Paul

[Frosty]

Great thread. Thank you gentlemen. No personal use for this yet, but thought I'd add in my two cents (mostly so I can find the thread again).

Paul, in the "how many programmers does it take to change a light bulb" vein, and since you said you weren't sure about the grouping... maybe simpler to read the comments if you take out the textual descriptions, as well as the extra code if you don't worry about building the string linearly, and just add a separate variable for positive number format and negative number format.

Function GetCurrencyFormat() As String
Dim sCurrencySymbol As String
Dim sFormatPositive As String
Dim sFormatNegative As String
Dim sNumber As String

'get currency symbol, ex: $
sCurrencySymbol = GetInfo(LOCALE_SCURRENCY)

'get generic number format ex: #,###.00
sNumber = "#" & GetInfo(LOCALE_STHOUSAND) & "##0" & GetInfo(LOCALE_SDECIMAL) & Left("000000000000", CLng(GetInfo(LOCALE_ICURRDIGITS)))

'get currency format for positive numbers
Select Case GetInfo(LOCALE_ICURRENCY)
Case "0" '$1.1
sFormatPositive = sCurrencySymbol & sNumber
Case "1" '1.1$
sFormatPositive = sNumber & sCurrencySymbol
Case "2" '$ 1.1
sFormatPositive = sCurrencySymbol & " " & sNumber
Case "3" '1.1 $
sFormatPositive = sNumber & " " & sCurrencySymbol
End Select

'get currency format for negative numbers
Select Case GetInfo(LOCALE_INEGCURR)
Case "0" '($1.1)
sFormatNegative = "(" & sCurrencySymbol & sNumber & ")"
Case "1" '-$1.1
sFormatNegative = "-" & sCurrencySymbol & sNumber
Case "2" '$-1.1
sFormatNegative = sCurrencySymbol & "-" & sNumber
Case "3" '$1.1-
sFormatNegative = sCurrencySymbol & sNumber & "-"
Case "4" '(1.1$)
sFormatNegative = "(" & sNumber & sCurrencySymbol & ")"
Case "5" '-1.1$
sFormatNegative = "-" & sNumber & sCurrencySymbol
Case "6" '1.1-$
sFormatNegative = sNumber & "-" & sCurrencySymbol
Case "7" '1.1$-
sFormatNegative = sNumber & sCurrencySymbol & "-"
Case "8" '-1.1 $
sFormatNegative = "-" & sNumber & " " & sCurrencySymbol
Case "9" '-$ 1.1
sFormatNegative = "-" & sCurrencySymbol & " " & sNumber
Case "10" '1.1 $-
sFormatNegative = sNumber & " " & sCurrencySymbol & "-"
Case "11" '$ 1.1-
sFormatNegative = sCurrencySymbol & " " & sNumber & "-"
Case "12" '$ -1.1
sFormatNegative = sCurrencySymbol & " " & "-" & sNumber
Case "13" '1.1- $
sFormatNegative = sNumber & "-" & " " & sCurrencySymbol
Case "14" '($ 1.1)
sFormatNegative = "(" & sCurrencySymbol & " " & sNumber & ")"
Case "15" '(1.1 $)
sFormatNegative = "(" & sNumber & " " & sCurrencySymbol & ")"
End Select

'return the whole kit and kaboodle
GetCurrencyFormat = sFormatPositive & ";" & sFormatNegative
End Function

[Frosty]

Ack... well, you meant "grouping" in terms of LOCALE_SGROUPING -- disregard my "helpful" rewrite. Grin.

Still, at least I'll be able to find the thread in my post history some day ;)

[Frosty]

Just a quick follow up, since I'm trying to be helpful... I'm not 100% sure, but it appears that parsing out the LOCALE_SGROUPING value may not be helpful (I started to, so I could actually contribute to the thread, and the realized that the Format function actually ignores anything I pass to it in terms of comma location-- which is news to me... I thought where I put the comma actually meant something).
Format(12345, "$##,##") = $12,345

If I change region (windows 7, at least), it appears to change the groupings of the same format function above. And, in fact, even if I use the format function with a comma, if I've set my region to Germany, it puts in a decimal (so-- no use for LOCALE_SDECIMAL?)

I could see one way of "improving" the above code... (using GetInfo(LOCALE_SNEGATIVESIGN) instead of "-"), but other than that, I think everything you did was readable and understandable.

Just a couple additional discoveries, in case either of you haven't already made them.

[gmaxey]

Paul,

I am not positive about what values SGROUPING will return but I believe the Indian's separtate like this 12,12,123.00, the Japanese like this 1234,1234.00 and most of the rest like this 123,123.00. I wonder if this would work:

Select Case GetInfo(LOCALE_SGROUPING)
Case "3;0"
sFirstGroup = "##0"
sSecondGroup = "###"
Case "3;2;0"
sFirstGroup = "##0"
sSecondGroup = "##"
Case "4;0"
sFirstGroup = "###0"
sSecondGroup = "####"
End Select
'get generic number format ex: #,###.00
sNumber = sSecondGroup & GetInfo(LOCALE_STHOUSAND) & sFirstGroup & GetInfo(LOCALE_SDECIMAL) & Left("000000000000", CLng(GetInfo(LOCALE_ICURRDIGITS)))


Thanks

1. I left the "sNumberFormat & " off of negative cases 1,2,3

2. The Grouping is still under work, and I don't know to sort that out yet

Paul

[gmaxey]

Jason,

Looks like you just found the train wreck. You're right is seems the format function ignores where one tries to tell it to put grouping separators.



Just a quick follow up, since I'm trying to be helpful... I'm not 100% sure, but it appears that parsing out the LOCALE_SGROUPING value may not be helpful (I started to, so I could actually contribute to the thread, and the realized that the Format function actually ignores anything I pass to it in terms of comma location-- which is news to me... I thought where I put the comma actually meant something).
Format(12345, "$##,##") = $12,345

If I change region (windows 7, at least), it appears to change the groupings of the same format function above. And, in fact, even if I use the format function with a comma, if I've set my region to Germany, it puts in a decimal (so-- no use for LOCALE_SDECIMAL?)

I could see one way of "improving" the above code... (using GetInfo(LOCALE_SNEGATIVESIGN) instead of "-"), but other than that, I think everything you did was readable and understandable.

Just a couple additional discoveries, in case either of you haven't already made them.

[Paul_Hossler]

LOCALE_SGROUPING

Sizes for each group of digits to the left of the decimal. The maximum number of characters allowed for this string is ten, including a terminating null character. An explicit size is needed for each group, and sizes are separated by semicolons. If the last value is 0, the preceding value is repeated. For example, to group thousands, specify 3;0. Indic locales group the first thousand and then group by hundreds. For example, 12,34,56,789 is represented by 3;2;0.

Further examples:

Specification Resulting string
3;0 3,000,000,000,000
3;2;0 30,00,00,00,00,000
3 3000000000,000
3;2 30000000,00,000


1. Frosty -- Thanks for the LOCAL_SNEGATIVE SIGN tip

2. Greg -- GROUPING is pretty complicated (see quote), but maybe your approach can be expanded a bit by parsing the string and building it ???

This is the latest incarnation of the function


Paul

[gmaxey]

Paul,

I didn't see your grouping suggestion in the attached file. Was it supposed to be there?


1. Frosty -- Thanks for the LOCAL_SNEGATIVE SIGN tip

2. Greg -- GROUPING is pretty complicated (see quote), but maybe your approach can be expanded a bit by parsing the string and building it ???

This is the latest incarnation of the function


Paul

[Frosty]

Paul, unless you find differently, I don't think parsing out the SGROUPING result helps if you're still going to pass the results to the VBA.Format function. VBA.Format appears to be doing its own thing anyway (based on some of the very LOCALE settings we're checking), irrespective of the more complex number formats we could put in. Essentially, it looks to me as if there are only two primary number formatting options regarding the "grouping" concept:
"#"
"#,#"

i.e., only the existence of a comma (not its location) seems to matter. Obviously 0 placeholders make a difference for number placeholders, but didn't seem to matter for grouping either. Try using the format function thusly:
Format("1234567890", "##,##,##,##,###")

This was true, at least, in Word 2010 in Windows 7. I haven't tested in any other environments.

[Frosty]

And an FYI, Paul... you're still missing the "sNumberFormat &" on a couple of your negative cases -- 1,2,3,9,11,12.

And doing just a little more reading on this... on OS higher than XP (Vista, Win7, etc), MS is recommending using GetLocaleInfoEx instead of GetLocaleInfo. A quick test of just changing the private declare function name still yielded "good" results on Windows 7, so maybe going back a few posts, the "standard" problem you'd encountered, Paul, is corrected in the new version of this function?

Just throwing stuff on the wall to see if it sticks :)

[gmaxey]

Paul/Jason,

This is fun but I've got a headache. This seems to be working but it depends on SGROUPING returning only "3;0" "3;2;0" and "4;0" Which handles my sytem which returns "3;0" and I think Chinese\Japanese returns "4;0" and Indian returns "3;2;0"

Option Explicit
Sub Test()
Debug.Print CustomFormatCurrency("1.09")
Debug.Print CustomFormatCurrency("-1.89")
Debug.Print CustomFormatCurrency("(10.79)")
Debug.Print CustomFormatCurrency("1000.45")
Debug.Print CustomFormatCurrency("-1999.99")
Debug.Print CustomFormatCurrency("(10666.89)")
Debug.Print CustomFormatCurrency("1599999999999999.99")
Debug.Print CustomFormatCurrency("-1599999999999999.99")
Debug.Print CustomFormatCurrency("(1599999999999999.99)")
End Sub
Function CustomFormatCurrency(ByRef strInput As String) As String
Dim strBasicFormat As String
Dim strBase As String
Dim strDec As String
Dim strSep As String
Dim strLeftPart As String
Dim strRightPart As String
Dim strPrefix As String
Dim strWholeNumberPart As String
Dim strGroupedNumber As String
Dim strFormattedNumber As String
Dim i As Long
Dim j As Long
Dim lngCount As Long

strBasicFormat = GetBasicFormat
strDec = GetInfo(LOCALE_SDECIMAL)
strSep = GetInfo(LOCALE_STHOUSAND)
strBase = Format(strInput, strBasicFormat)
strLeftPart = Right(strBase, Len(strBase) - InStr(strBase, strDec) + 1)
strRightPart = Left(strBase, Len(strBase) - Len(strLeftPart))
strRightPart = Replace(strRightPart, strSep, "")
For i = 1 To Len(strRightPart)
If Not Mid(strRightPart, i, 1) Like "[0-9]" Then
strPrefix = strPrefix & Mid(strRightPart, i, 1)
Else
strWholeNumberPart = strWholeNumberPart & Mid(strRightPart, i, 1)
End If
Next i

Select Case GetInfo(LOCALE_SGROUPING) '"3;0" '"4;0" '"3;2;0"
Case "3;0"
lngCount = 3
For i = Len(strWholeNumberPart) To 1 Step -1
strGroupedNumber = Mid(strWholeNumberPart, i, 1) & strGroupedNumber
j = j + 1
If j = lngCount Then
If i > 1 Then
strGroupedNumber = strSep & strGroupedNumber
j = 0
End If
End If
Next i
Case "3;2;0"
lngCount = 3
For i = Len(strWholeNumberPart) To 1 Step -1
strGroupedNumber = Mid(strWholeNumberPart, i, 1) & strGroupedNumber
j = j + 1
If j = lngCount Then
If i > 1 Then
strGroupedNumber = strSep & strGroupedNumber
lngCount = 2
j = 0
End If
End If
Next i
Case "4;0"
lngCount = 4
For i = Len(strWholeNumberPart) To 1 Step -1
strGroupedNumber = Mid(strWholeNumberPart, i, 1) & strGroupedNumber
j = j + 1
If j = lngCount Then
If i > 1 Then
strGroupedNumber = strSep & strGroupedNumber
j = 0
End If
End If
Next i
End Select
strFormattedNumber = strPrefix & strGroupedNumber & strLeftPart
CustomFormatCurrency = strFormattedNumber
End Function
Function GetBasicFormat() As String
Const csLeft As String = "("
Const csRight As String = ")"
Const csSpace As String = " "
Dim sCurrencySymbol As String, sMinusSign As String
Dim sNumberFormat As String, sNumber As String
sCurrencySymbol = GetInfo(LOCALE_SCURRENCY)
sMinusSign = GetInfo(LOCALE_SNEGATIVESIGN)
sNumber = "#" & GetInfo(LOCALE_STHOUSAND) & "##0" & GetInfo(LOCALE_SDECIMAL) & Left("000000000000", CLng(GetInfo(LOCALE_ICURRDIGITS)))

Select Case GetInfo(LOCALE_ICURRENCY)
'Prefix, no separation, for example, $1.1
Case "0": sNumberFormat = sCurrencySymbol & sNumber
'Suffix, no separation, for example, 1.1$
Case "1": sNumberFormat = sNumber & sCurrencySymbol
'Prefix, 1-character separation, for example, $ 1.1
Case "2": sNumberFormat = sCurrencySymbol & csSpace & sNumber
'Suffix, 1-character separation, for example, 1.1 $
Case "3": sNumberFormat = sNumber & csSpace & sCurrencySymbol
End Select

sNumberFormat = sNumberFormat & ";"

Select Case GetInfo(LOCALE_INEGCURR)
'Left parenthesis, monetary symbol, number, right parenthesis; for example, ($1.1)
Case "0": sNumberFormat = sNumberFormat & csLeft & sCurrencySymbol & sNumber & csRight
'Negative sign, monetary symbol, number; for example, -$1.1
Case "1": sNumberFormat = sNumberFormat & sMinusSign & sCurrencySymbol & sNumber
'Monetary symbol, negative sign, number; for example, $-1.1
Case "2": sNumberFormat = sNumberFormat & sCurrencySymbol & sMinusSign & sNumber
'Monetary symbol, number, negative sign; for example, $1.1-
Case "3": sNumberFormat = sNumberFormat & sCurrencySymbol & sNumber & sMinusSign
'Left parenthesis, number, monetary symbol, right parenthesis; for example, (1.1$)"
Case "4": sNumberFormat = sNumberFormat & csLeft & sNumber & sCurrencySymbol & csRight
'Negative sign, number, monetary symbol; for example, -1.1$
Case "5": sNumberFormat = sNumberFormat & sMinusSign & sNumber & sCurrencySymbol
'Number, negative sign, monetary symbol; for example, 1.1-$
Case "6": sNumberFormat = sNumberFormat & sNumber & sMinusSign & sCurrencySymbol
'Number, monetary symbol, negative sign; for example, 1.1$-"
Case "7": sNumberFormat = sNumberFormat & sNumber & sCurrencySymbol & sMinusSign
'Negative sign, number, space, monetary symbol (like #5, but with a space before the monetary symbol); for example, -1.1 $
Case "8": sNumberFormat = sNumberFormat & sMinusSign & sNumber & csSpace & sCurrencySymbol
'Negative sign, monetary symbol, space, number (like #1, but with a space after the monetary symbol); for example, -$ 1.1
Case "9": sNumberFormat = sNumberFormat & sMinusSign & sCurrencySymbol & csSpace & sNumber
'Number, space, monetary symbol, negative sign (like #7, but with a space before the monetary symbol); for example, 1.1 $-
Case "10": sNumberFormat = sNumberFormat & sNumber & csSpace & sCurrencySymbol & sMinusSign
'Monetary symbol, space, number, negative sign (like #3, but with a space after the monetary symbol); for example, $ 1.1-
Case "11": sNumberFormat = sNumberFormat & sCurrencySymbol & csSpace & sNumber & sMinusSign
'Monetary symbol, space, negative sign, number (like #2, but with a space after the monetary symbol); for example, $ -1.1
Case "12": sNumberFormat = sNumberFormat & sCurrencySymbol & csSpace & sMinusSign & sNumber
'Number, negative sign, space, monetary symbol (like #6, but with a space before the monetary symbol); for example, 1.1- $"
Case "13": sNumberFormat = sNumberFormat & sNumber & sMinusSign & csSpace & sCurrencySymbol
'Left parenthesis, monetary symbol, space, number, right parenthesis (like #0, but with a space after the monetary symbol); for example, ($ 1.1)
Case "14": sNumberFormat = sNumberFormat & csLeft & sCurrencySymbol & csSpace & sNumber & csRight
'Left parenthesis, number, space, monetary symbol, right parenthesis (like #4, but with a space before the monetary symbol); for example, (1.1 $)
Case "15": sNumberFormat = sNumberFormat & csLeft & sNumber & csSpace & sCurrencySymbol & csRight
End Select
GetBasicFormat = sNumberFormat
lbl_Exit:
Exit Function
End Function

[gmaxey]

Jason,

As you know, I don't really understand most of the code I write. How would I change to user GetLocalEx rather than GetLocal?


And an FYI, Paul... you're still missing the "sNumberFormat &" on a couple of your negative cases -- 1,2,3,9,11,12.

And doing just a little more reading on this... on OS higher than XP (Vista, Win7, etc), MS is recommending using GetLocaleInfoEx instead of GetLocaleInfo. A quick test of just changing the private declare function name still yielded "good" results on Windows 7, so maybe going back a few posts, the "standard" problem you'd encountered, Paul, is corrected in the new version of this function?

Just throwing stuff on the wall to see if it sticks :)

[Frosty]

Greg, you are far too humble :)

To make that change, just change this line... and then try to compile your project. Anywhere else you used GetLocaleInfo would need to be changed to GetLocaleInfoEx.

Private Declare Function GetLocaleInfoEx Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, _
ByVal LCType As Long, _
ByVal lpLCData As String, _
ByVal cchData As Long) As Long

[Frosty]

Actually, scratch that, as it's the Alias that matters... now I have to confess I don't know what I'm doing either :)

Hold please...

[Frosty]

http://msdn.microsoft.com/en-us/library/aa165080%28v=office.10%29.aspx
This is the anatomy of how the private declare works...

Big note here:
I'm managing to crash Word every time when attempting to actually use GetLocaleInfoEx. But here is how it "should" work...
The actual API is called GetLocaleInfoA or GetLocaleInfoEx... so the different ways of declaring (so that you don't have to change it all through the code) are the following:

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

Or this one...However, this causes my Word to crash when I try to actually run it. I'm in somewhat of a unique environment (Windows 7 virtual machine on an iMac), but I've never had a problem before.

Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoEx" (ByVal Locale As Long, _
ByVal LCType As Long, _
ByVal lpLCData As String, _
ByVal cchData As Long) As Long

[Frosty]

Completely backasswards way of using the word "Alias" to my mind... but at least I now understand how this whole thing works now!

[gmaxey]

Now I'm hopelessly lost ;-)

The top version works without issue. The other crashes Word everytime.


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 GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoEx" (ByVal Locale As Long, _
' ByVal LCType As Long, _
' ByVal lpLCData As String, _
' ByVal cchData As Long) As Long

[Frosty]

In a funny kind of way, that's how you know it's "working as intended"... because if you change "GetLocaleInfoEx" to "GetLocaleInfoYadaYada" then the function will run, but you'll get a "Dll Entry Point not found" error... which means it's a specific crash bug, rather than just some random letters which cause the crash.

So, despite MS telling us to use a different WinAPI in Windows Vista/Windows 7, clearly VBA isn't ready to handle that. It may have to do with some of the other issues raised in the above link, but I've always had a gift for finding crash bugs...

Nothing to see here... carry on with the original.

[Paul_Hossler]

I didn't see your grouping suggestion in the attached file. Was it supposed to be there?


Nope, never had an idea that I was confortable with. The all seemed kludgy or failed the simplest tests




And an FYI, Paul... you're still missing the "sNumberFormat &" on a couple of your negative cases -- 1,2,3,9,11,12.


Nuts, nuts, and double darn

Paul

[gmaxey]

Well the idea I had and posted is certainly kludgy, but it seems to pass a few simple tests at least.

[Frosty]

What bothers me is that it seems like you have to throw away the entire power of the VBA.Format functionality in order to use the SGROUPING. I'd have to be presented with a very clear problem to choose the "solution" which throws out VBA.Format.

At that point, I have a feeling kludgy would suffice

[Paul_Hossler]

Still playing around ( 'investigating') this since it has some utility for my international Excel template projects also.

I'm also reluctant to not use the power of VBA. The FormatCurrency() function has a Group parameter, but the way I read it, it only seems to use the 1000's seperator (e.g. comma in US), and NOT to actually group the digits 12,23,56,789.12.

I'd guess that plain old Format() with a format string ($#,##0.00) works the same way, and that seems to be what you both found



FormatCurrency(Expression[,NumDigitsAfterDecimal [,IncludeLeadingDigit [,UseParensForNegativeNumbers [,GroupDigits]]]])

The FormatCurrency function syntax has these parts:

GroupDigitsOptional.

Tristate constant that indicates whether or not numbers are grouped using the group delimiter specified in the computer's regional settings. See Settings section for values.



I changed my WRS to India and tried this, without the expected (hoped for)
12,34,56,789.00


Sub test()

Dim s As String

s = FormatCurrency(12345678.9876, True, vbUseDefault, vbUseDefault, True)
MsgBox s
s = FormatCurrency(12345678.9876, True, vbUseDefault, vbUseDefault, False)
MsgBox s
s = FormatCurrency(12345678.9876, True, vbUseDefault, vbUseDefault, vbUseDefault)
MsgBox s

End Sub


Paul

[Paul_Hossler]

Greg -- don't know if you're still following this thread, or are even interested. but for Currency the only thing I've fond that is reliable for all the WRS I've tested is the VBA FormatCurrency() function

The constructed NumberFormat string (S) 'looks good' :dunno but Format doesn't handle it right:banghead:


Sub drv2()

'-------------------- not a big fan of doing it this way
Dim s As String

s = FormatCurrency(1111.222, -1, vbUseDefault, vbUseDefault, vbUseDefault) & ";"
s = s & FormatCurrency(-1111.222, -1, vbUseDefault, vbUseDefault, vbUseDefault) & ";"
s = s & FormatCurrency(0#, -1, vbUseDefault, vbUseDefault, vbUseDefault)

s = Replace(s, "1", "#")
s = Replace(s, "2", "0")
s = Application.WorksheetFunction.Substitute(s, "### ", vbNullString)

MsgBox s

'format seems to not handle it correctly
MsgBox Format(1111111.1111, s)

'------------------- this seems to work
MsgBox FormatCurrency(22222222.22222)
MsgBox FormatCurrency(-22222222.22222)
MsgBox FormatCurrency(0#)


'------------------- this seems to work
MsgBox Format(33333333.3333, "currency")
MsgBox Format(-33333333.3333, "currency")
MsgBox Format(0, "currency")

End Sub


I still have your API call code since it returns a lot of useful (to me at least) info, but I'm back to VBA's FormatCurrency to money:doh:

Paul

[chensi]

good job.happy everyday please.


_________________________________________________________________
I live my life in colour and see in soundMake sure you are heard!

(http://www.wly.com/)