Consulting

Results 1 to 4 of 4

Thread: Convert OMR currency numbers to words

  1. #1

    Convert OMR currency numbers to words

    How can the numbers of Omani Riyal currency be shown or converted to words (letters) automatically.

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,783
    Location
    Parse the value from least to largest, lookup the terminology; add terminology to indicate magnitudes. Pay attention to special cases,

    English Dollar example: $123,456,789.10

    Magnitudes = Array("Hundred","Thousand","Million","Billion","Trillion")
    
    Cents = Split(Value, ".")(1)
    Dollars = Value - "." & Cents
    Groups = Split(Value, ",")
       'If you don't use separators, you will have to separate by counting digits
    
       'Reverse the Groups
    For i = Ubound(Groups) To LBound(Groups) Step -1
       GroupsRev = GroupsRev & Groups(i) & ","
    Next i
    GroupsRev = Split(GroupsRev, ",")
       'GroupsRev is in Smallest to Largest order. Empty Group at end?
    
       'Parse each GroupRev to Words
    For i = Lbound(GroupRev To Uboulnd(GroupRev)
     'Blah, Blah, Blah
    Result = ParsedGroup & WorksheetFunction.Index(Magnitudes, i + 1) & Result
    Next i
       'Result is now again in Largest to smallest order
    
       'Add Cents
    Result = Result & " and " & Cents & " Dollars"

    Hope this Helps. Sorry I couldn't do more, I don't have Office installed on this new computer.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    Thank you dear,
    but I need the codes for OMR currency.

    I have the code for Dollars as follow:

    Function NumberstoWords(ByVal pNumber)
    Dim Dollars, Cents
    arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
    pNumber = Trim(Str(pNumber))
    xDecimal = InStr(pNumber, ".")
    If xDecimal > 0 Then
        Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
        pNumber = Trim(Left(pNumber, xDecimal - 1))
    End If
    xIndex = 1
    Do While pNumber <> ""
        xHundred = ""
        xValue = Right(pNumber, 3)
        If Val(xValue) <> 0 Then
            xValue = Right("000" & xValue, 3)
            If Mid(xValue, 1, 1) <> "0" Then
                xHundred = GetDigit(Mid(xValue, 1, 1)) & " Hundred "
            End If
            If Mid(xValue, 2, 1) <> "0" Then
                xHundred = xHundred & GetTens(Mid(xValue, 2))
            Else
                xHundred = xHundred & GetDigit(Mid(xValue, 3))
            End If
        End If
        If xHundred <> "" Then
            Dollars = xHundred & arr(xIndex) & Dollars
        End If
        If Len(pNumber) > 3 Then
            pNumber = Left(pNumber, Len(pNumber) - 3)
        Else
            pNumber = ""
        End If
        xIndex = xIndex + 1
    Loop
    Select Case Dollars
        Case ""
            Dollars = "No Dollars"
        Case "One"
            Dollars = "One Dollar"
        Case Else
            Dollars = Dollars & " Dollars"
    End Select
    Select Case Cents
        Case ""
            Cents = " and No Cents"
        Case "One"
            Cents = " and One Cent"
        Case Else
            Cents = " and " & Cents & " Cents"
    End Select
    NumberstoWords = Dollars & Cents
    End Function
    Function GetTens(pTens)
    Dim Result As String
    Result = ""
    If Val(Left(pTens, 1)) = 1 Then
        Select Case Val(pTens)
            Case 10: Result = "Ten"
            Case 11: Result = "Eleven"
            Case 12: Result = "Twelve"
            Case 13: Result = "Thirteen"
            Case 14: Result = "Fourteen"
            Case 15: Result = "Fifteen"
            Case 16: Result = "Sixteen"
            Case 17: Result = "Seventeen"
            Case 18: Result = "Eighteen"
            Case 19: Result = "Nineteen"
            Case Else
        End Select
    Else
    Select Case Val(Left(pTens, 1))
        Case 2: Result = "Twenty "
        Case 3: Result = "Thirty "
        Case 4: Result = "Forty "
        Case 5: Result = "Fifty "
        Case 6: Result = "Sixty "
        Case 7: Result = "Seventy "
        Case 8: Result = "Eighty "
        Case 9: Result = "Ninety "
        Case Else
    End Select
    Result = Result & GetDigit(Right(pTens, 1))
    End If
    GetTens = Result
    End Function
    Function GetDigit(pDigit)
    Select Case Val(pDigit)
        Case 1: GetDigit = "One"
        Case 2: GetDigit = "Two"
        Case 3: GetDigit = "Three"
        Case 4: GetDigit = "Four"
        Case 5: GetDigit = "Five"
        Case 6: GetDigit = "Six"
        Case 7: GetDigit = "Seven"
        Case 8: GetDigit = "Eight"
        Case 9: GetDigit = "Nine"
        Case Else: GetDigit = ""
    End Select
    End Function
    Last edited by SamT; 06-15-2022 at 09:19 AM.

  4. #4
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,783
    Location
    Hey sweety,

    The logic is the same for any currency:

    Parse the value from least to largest, lookup the terminology; add terminology to indicate magnitudes. Pay attention to special cases.
    If you come up with the base code, I will help you correct and perfect it. I will not spend time to learn the ins and outs of OMR nor the Omani language. (Time = Money. I am busy.)

    I will leave this thread here so that anyone who desires can give you a Bespoke solution.
    Last edited by SamT; 06-15-2022 at 09:44 AM.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

Posting Permissions

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