/ Snippet Library - View Code

Visual Basic / Math / Numbers to Text

Snippet details

ID: 381

Viewed: 1157

Added: 2002-08-19

Version:

Snippets in this catagory
Show Printable Version

Numbers to Text

General Details

Snippet uploaded by: snippet

Email : webmaster@snippetlibrary.com

Snippet By: Unknown

Snippet By:	Unknown
Declarations
Highlight Allnone
Code
Highlight All' ' 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 Reviews to show