Results 1 to 3 of 3
  1. #1
    Join Date
    Jul 2010
    Posts
    26

    Convert numbers to words WITH negatives

    I have tailored some code on the internet to make it work to my needs. I have read that it is fairly simple to tailor the code to make it handle negatives. Could someone help me out? I am having trouble making it work. Here is code that works perfectly, but only for positive numbers:
    Code:
    Function SpellNumber(ByVal MyNumber)
        
    Dim pointpercentTemp
        Dim DecimalPlace
    Count
     
        ReDim Place
    (9) As String
        Place
    (2) = " Thousand "
        
    Place(3) = " Million "
        
    Place(4) = " Billion "
        
    Place(5) = " Trillion "
     
        ' String representation of amount
        MyNumber = Trim(Str(MyNumber))
     
        ' 
    Position of decimal place 0 if none
        DecimalPlace 
    InStr(MyNumber".")
        
    'Convert percent and set MyNumber to dollar amount
        If DecimalPlace > 0 Then
            percent = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
        End If
     
        Count = 1
        Do While MyNumber <> ""
           Temp = GetHundreds(Right(MyNumber, 3))
           If Temp <> "" Then point = Temp & Place(Count) & point
              If Len(MyNumber) > 3 Then
                 MyNumber = Left(MyNumber, Len(MyNumber) - 3)
            Else
                MyNumber = ""
            End If
            Count = Count + 1
        Loop
     
        Select Case point
            Case ""
                point = "zero point"
            Case "One"
                point = "one percent"
            Case Else
                point = point & "point"
        End Select
     
        Select Case percent
            Case ""
                percent = " zero percent"
            Case "One"
                percent = " one percent"
            Case Else
                percent = " " & percent & "percent"
        End Select
     
        SpellNumber = point & percent
    End Function
     
    '
    *******************************************
    ' Converts a number from 100-999 into text *
    '
    *******************************************
    Function 
    GetHundreds(ByVal MyNumber)
        
    Dim Result As String
     
        
    If Val(MyNumber) = 0 Then Exit Function
        
    MyNumber Right("000" MyNumber3)
     
        
    'Convert the hundreds place
        If Mid(MyNumber, 1, 1) <> "0" Then
            Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
        End If
     
        '
    Convert the tens and ones place
        
    If Mid(MyNumber21) <> "0" Then
            Result 
    Result GetTens(Mid(MyNumber2))
        Else
            
    Result Result GetDigit(Mid(MyNumber3))
        
    End If
     
        
    GetHundreds Result
    End 
    Function
     


    '*********************************************
    Converts a number from 10 to 99 into text. *
    '*********************************************
    Function GetTens(TensText)
        Dim Result As String
     
        Result = ""           '
    null out the temporary function value
        
    If Val(Left(TensText1)) = 1 Then   ' If value between 10-19
            Select Case Val(TensText)
                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                                 ' 
    If value between 20-99
            Select 
    Case Val(Left(TensText1))
                Case 
    2Result "twenty "
                
    Case 3Result "thirty "
                
    Case 4Result "forty "
                
    Case 5Result "fifty "
                
    Case 6Result "sixty "
                
    Case 7Result "seventy "
                
    Case 8Result "eighty "
                
    Case 9Result "ninety "
                
    Case Else
            
    End Select
             Result 
    Result GetDigit _
                
    (Right(TensText1))  'Retrieve ones place
          End If
          GetTens = Result
       End Function
     
    '
    *******************************************
    ' Converts a number from 1 to 9 into text. *
    '
    *******************************************
    Function 
    GetDigit(Digit)
        
    Select Case Val(Digit)
            Case 
    1GetDigit "one "
            
    Case 2GetDigit "two "
            
    Case 3GetDigit "three "
            
    Case 4GetDigit "four "
            
    Case 5GetDigit "five "
            
    Case 6GetDigit "six "
            
    Case 7GetDigit "seven "
            
    Case 8GetDigit "eight "
            
    Case 9GetDigit "nine "
            
    Case Else: GetDigit ""
        
    End Select
    End 
    Function 

    Thanks in advance

  2. #2
    cowboy is offline Competent Performer
    Windows XP Access 2003
    Join Date
    Jan 2010
    Posts
    291
    What does it do when you put in a negative number?

  3. #3
    Join Date
    Jul 2010
    Location
    GA.
    Posts
    23

    Convert a currency value into an English string

    Hey Alexandre see if this code will help you any.


    ' Convert a currency value into an (American) 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 & " exactly"
    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
    '************ Code End **********

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Convert text to numbers
    By Mclaren in forum Programming
    Replies: 2
    Last Post: 05-02-2010, 01:36 PM
  2. Convert text to numbers
    By randolphoralph in forum Access
    Replies: 1
    Last Post: 03-21-2010, 10:33 AM
  3. Textbox, remove certain words.
    By dgrzalja in forum Forms
    Replies: 0
    Last Post: 11-03-2009, 09:42 AM
  4. tags and words in a row
    By bimfire in forum Access
    Replies: 0
    Last Post: 11-07-2007, 10:53 PM
  5. Replies: 10
    Last Post: 11-13-2006, 02:07 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums