Not a Member Yet,
Click here to Register
How do you like the new design?






ID: 381
Viewed: 2570
Added: Aug 19, 2002
Version:
Snippet uploaded by: snippet
Written By: Unknown
Demo: Sorry, no demo



User Rated at: 1 Stars
Rate This:

Thank you for your vote. Please wait...

It appears you already voted for this snippet

It appears your vote value was empty

Numbers to Text

Highlight all by clicking in box
<!---Declaration--->
none

Highlight All
<!---Code--->
'
' Found on the net somewhere - apologies to author
'
Private Function NumToText(dblVal As Double) As String
Static sOnes(0 To 9) As String
Static sTeens(0 To 9) As String
Static sTens(0 To 9) As String
Static sThousands(0 To 4) As String
Static bInit As Boolean

Dim i As Integer
Dim bAllZeros As Boolean
Dim bShowsThousands As Boolean
Dim sValue As String
Dim sBuffer As String
Dim sTemp As String
Dim iCol As Integer
Dim iChar As Integer
'
' Warning - this routine only handles positive values
'
Debug.Assert dblVal > 0

If bInit = False Then
'Initialize array
bInit = True
sOnes(0) = "zero"
sOnes(1) = "one"
sOnes(2) = "two"
sOnes(3) = "three"
sOnes(4) = "four"
sOnes(5) = "five"
sOnes(6) = "six"
sOnes(7) = "seven"
sOnes(8) = "eight"
sOnes(9) = "nine"
sTeens(0) = "ten"
sTeens(1) = "eleven"
sTeens(2) = "twelve"
sTeens(3) = "thirteen"
sTeens(4) = "fourteen"
sTeens(5) = "fifteen"
sTeens(6) = "sixteen"
sTeens(7) = "seventeen"
sTeens(8) = "eighteen"
sTeens(9) = "nineteen"
sTens(0) = ""
sTens(1) = "ten"
sTens(2) = "twenty"
sTens(3) = "thirty"
sTens(4) = "forty"
sTens(5) = "fifty"
sTens(6) = "sixty"
sTens(7) = "seventy"
sTens(8) = "eighty"
sTens(9) = "ninety"
sThousands(0) = ""
sThousands(1) = "thousand" 'US numbering
sThousands(2) = "million"
sThousands(3) = "billion"
sThousands(4) = "trillion"
End If
'
' Setup Error Handler
'
On Error GoTo vbErrorHandler
'
' Get fractional part of value (if any)
'
sBuffer = "and " & Format$((dblVal - Int(dblVal)) * 100, "00") & "/100"
'
' Convert main part to string
'
sValue = CStr(Int(dblVal))

bAllZeros = True

For i = Len(sValue) To 1 Step -1
iChar = Val(Mid$(sValue, i, 1))
iCol = (Len(sValue) - i) + 1
'
'Action depends on 1's, 10's or 100's column
'
Select Case (iCol Mod 3)
Case 1 '1's position
bShowsThousands = True
If i = 1 Then
sTemp = sOnes(iChar) & " "
ElseIf Mid$(sValue, i - 1, 1) = "1" Then
sTemp = sTeens(iChar) & " "
i = i - 1
ElseIf iChar > 0 Then
sTemp = sOnes(iChar) & " "
Else
bShowsThousands = False
If Mid$(sValue, i - 1, 1) <> "0" Then
bShowsThousands = True
ElseIf i > 2 Then
If Mid$(sValue, i - 2, 1) <> "0" Then
bShowsThousands = True
End If
End If
sTemp = ""
End If
If bShowsThousands Then
If iCol > 1 Then
sTemp = sTemp & sThousands(iCol 3)
If bAllZeros Then
sTemp = sTemp & " "
Else
sTemp = sTemp & ", "
End If
End If
bAllZeros = False
End If
sBuffer = sTemp & sBuffer
Case 2
If iChar > 0 Then
If Mid$(sValue, i + 1, 1) <> "0" Then
sBuffer = sTens(iChar) & "-" & sBuffer
Else
sBuffer = sTens(iChar) & " " & sBuffer
End If
End If
Case 0
If iChar > 0 Then
sBuffer = sOnes(iChar) & " hundred " & sBuffer
End If
End Select
Next i

sBuffer = UCase$(Left$(sBuffer, 1)) & Mid$(sBuffer, 2)

EndNumToText:
NumToText = sBuffer
Exit Function

vbErrorHandler:
sBuffer = "#Error#"
Resume EndNumToText
End Function
;


No Comments to show

Please completely fill out the form below if you want to review this snippet. All reviews are subject to validation.


Replying to a Comment...


Adding your comment. Please wait...

Thanks for adding your comment!. After further review it will be added.

There was a problem adding your comment. Please try again.

Please complete all the fields in the form before sending.

© 2002 - 2017 snippetlibrary.com All Rights Reserved. Conditions