Results 1 to 4 of 4
  1. #1
    Join Date
    Jun 2013
    Posts
    2

    Red face Unanswered: Add currency strings

    Good Day,

    I have three fields in an access table:
    1) Amount: Numeric Value of a currency eg 12.34
    2) CurrencyUsed: I am using a dropdown menu for four currencies ie, ZMK, ZAR,USD,GBP, which the user chooses.
    3) AmountInWords: Uses a module that is called from a query to convert the Amount field to words.

    I was able to convert the numeric value to be converted to words using the macro below. But I cannot make it display the CurrencyUsed.

    An example:
    User types in 12.34 in Amount and chooses USD. In AmountInWords I want it to display twelve dollars and thirty four cents only. Currently its just displaying twelve and thirty four only.

    ' Convert a currency value into an English string
    Function English(ByVal N As Currency) As String
    Const Thousand = 1000@
    Const Million = Thousand * Thousand
    Const Billion = Thousand * Million
    Const Trillion = Thousand * Billion

    If (N = 0@) Then English = "zero": Exit Function

    Dim Buf As String: If (N < 0@) Then Buf = "negative " Else Buf = ""
    Dim Frac As Currency: Frac = Abs(N - Fix(N))
    If (N < 0@ Or Frac <> 0@) Then N = Abs(Fix(N))
    Dim AtLeastOne As Integer: AtLeastOne = N >= 1

    If (N >= Trillion) Then
    Debug.Print N
    Buf = Buf & EnglishDigitGroup(Int(N / Trillion)) & " trillion"
    N = N - Int(N / Trillion) * Trillion ' Mod overflows
    If (N >= 1@) Then Buf = Buf & " "
    End If

    If (N >= Billion) Then
    Debug.Print N
    Buf = Buf & EnglishDigitGroup(Int(N / Billion)) & " billion"
    N = N - Int(N / Billion) * Billion ' Mod still overflows
    If (N >= 1@) Then Buf = Buf & " "
    End If

    If (N >= Million) Then
    Debug.Print N
    Buf = Buf & EnglishDigitGroup(N \ Million) & " million"
    N = N Mod Million
    If (N >= 1@) Then Buf = Buf & " "
    End If

    If (N >= Thousand) Then
    Debug.Print N
    Buf = Buf & EnglishDigitGroup(N \ Thousand) & " thousand"
    N = N Mod Thousand
    If (N >= 1@) Then Buf = Buf & " "
    End If

    If (N >= 1@) Then
    Debug.Print N
    Buf = Buf & EnglishDigitGroup(N)
    End If

    If (Frac = 0@) Then
    Buf = Buf & " Only"
    ElseIf (Int(Frac * 100@) = Frac * 100@) Then
    If AtLeastOne Then Buf = Buf & " and "
    Buf = Buf & Format$(Frac * 100@, "00") & "/100"
    Else
    If AtLeastOne Then Buf = Buf & " and "
    Buf = Buf & Format$(Frac * 10000@, "0000") & "/10000"
    End If

    English = Buf
    End Function

    ' Support function to be used only by English()
    Private Function EnglishDigitGroup(ByVal N As Integer) As String
    Const Hundred = " hundred"
    Const One = "One"
    Const Two = "Two"
    Const Three = "Three"
    Const Four = "Four"
    Const Five = "Five"
    Const Six = "Six"
    Const Seven = "Seven"
    Const Eight = "Eight"
    Const Nine = "Nine"
    Dim Buf As String: Buf = ""
    Dim Flag As Integer: Flag = False

    'Do hundreds
    Select Case (N \ 100)
    Case 0: Buf = "": Flag = False
    Case 1: Buf = One & Hundred: Flag = True
    Case 2: Buf = Two & Hundred: Flag = True
    Case 3: Buf = Three & Hundred: Flag = True
    Case 4: Buf = Four & Hundred: Flag = True
    Case 5: Buf = Five & Hundred: Flag = True
    Case 6: Buf = Six & Hundred: Flag = True
    Case 7: Buf = Seven & Hundred: Flag = True
    Case 8: Buf = Eight & Hundred: Flag = True
    Case 9: Buf = Nine & Hundred: Flag = True
    End Select

    If (Flag <> False) Then N = N Mod 100
    If (N > 0) Then
    If (Flag <> False) Then Buf = Buf & " "
    Else
    EnglishDigitGroup = Buf
    Exit Function
    End If

    'Do tens (except teens)
    Select Case (N \ 10)
    Case 0, 1: Flag = False
    Case 2: Buf = Buf & "twenty": Flag = True
    Case 3: Buf = Buf & "thirty": Flag = True
    Case 4: Buf = Buf & "forty": Flag = True
    Case 5: Buf = Buf & "fifty": Flag = True
    Case 6: Buf = Buf & "sixty": Flag = True
    Case 7: Buf = Buf & "seventy": Flag = True
    Case 8: Buf = Buf & "eighty": Flag = True
    Case 9: Buf = Buf & "ninety": Flag = True
    End Select

    If (Flag <> False) Then N = N Mod 10
    If (N > 0) Then
    If (Flag <> False) Then Buf = Buf & "-"
    Else
    EnglishDigitGroup = Buf
    Exit Function
    End If

    'Do ones and teens
    Select Case (N)
    Case 0: ' do nothing
    Case 1: Buf = Buf & One
    Case 2: Buf = Buf & Two
    Case 3: Buf = Buf & Three
    Case 4: Buf = Buf & Four
    Case 5: Buf = Buf & Five
    Case 6: Buf = Buf & Six
    Case 7: Buf = Buf & Seven
    Case 8: Buf = Buf & Eight
    Case 9: Buf = Buf & Nine
    Case 10: Buf = Buf & "ten"
    Case 11: Buf = Buf & "eleven"
    Case 12: Buf = Buf & "twelve"
    Case 13: Buf = Buf & "thirteen"
    Case 14: Buf = Buf & "fourteen"
    Case 15: Buf = Buf & "fifteen"
    Case 16: Buf = Buf & "sixteen"
    Case 17: Buf = Buf & "seventeen"
    Case 18: Buf = Buf & "eighteen"
    Case 19: Buf = Buf & "nineteen"
    End Select

    EnglishDigitGroup = Buf
    End Function

    If someone can show me how to do the USD and GBP ie Dollars and cents as well as Pounds and pence, I will be able to sort out the remaining currencies.

    Thanks

    Fazleh

  2. #2
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    at some point you have to supply the major and minor parts of the currency
    persoanlly I'd do it by supplying the currency code as part of the call to the function and allow the function to retrieve the major and minor units of currency from another table. the problek, is that some currencies have plurals, some do not

    eg Dollar/Dollars, Cent/Cents, Pound /Pounds, Penny or Pence/Pennies or pence

    so you need a table which associates a currency code (use the ISO 3 digit currency code) and its major and mionor units and optionally the plurals of those units. you might as well stroe the currency name whilst you are at it.

    then either do a dlookup for the correct text or retrieve all the elements as a recordset


    lets assume you have an incoming value called CurVal
    if curval >=2 then you need the plural of the currency name
    if the decimal part of curval is >.1 then you need the plural of the currency minorvalue

    Code:
    MajorUnit = int(curval)
    MinorUnit= CurVal=MajorUnit
    if MajorUnit >1 then
      MajorName = DLOOKUP('MAJORUNIT','CURRENCYTABLE',"CODE='" & MYCURRENCYCODE & "'")
    else
      MajorName = DLOOKUP('MAJORUNITPLURAL','CURRENCYTABLE',"CODE='" & MYCURRENCYCODE & "'")
    endif
    if MinorUnit >1 then
      MinorName = DLOOKUP('MINORUNIT','CURRENCYTABLE',"CODE='" & MYCURRENCYCODE & "'")
    else
      MinorName = DLOOKUP('MINORUNITPLURAL','CURRENCYTABLE',"CODE='" & MYCURRENCYCODE & "'")
    endif
    you will need to build in some validation to handle missign currency codes and or missing plural values
    I'd rather be riding on the Tiger 800 or the Norton

  3. #3
    Join Date
    Jun 2013
    Posts
    2
    How and where do i replicate your piece of code into mine?

  4. #4
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    that code creates two variables
    MajorName and MinorName so use those where you need dollars/Pounds and Cents/Pennies
    butr you will need to creeate your table which has the currency names in

    you need to repalce the variables in that code with the table/column names you've used
    I'd rather be riding on the Tiger 800 or the Norton

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •