NumToText

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