Here is a set of functions that I use for doing this.
There are two functions listed below. Both must be put into a regular
module. You need call only the ConvertMoneyNumbersToText function to get the
desired results. The ConvertMoneyNumbersToText function calls the other
function as part of its work.
' *****************************************
' ** Function ConvertMoneyNumbersToText **
' *****************************************
Public Function ConvertMoneyNumbersToText(ByVal curNumberValue As _
Currency) As String
'This code was originally written by Joe Foster.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Joe Foster
'
'Modified by Ken Snell 15 May 2005
' *** THIS FUNCTION CONVERTS A NUMERIC "MONETARY" VALUE INTO A TEXT STRING
' *** THAT CONTAINS THE WORDS THAT REPRESENT THE "MONETARY" VALUE.
Dim xblnExact As Boolean
'Dim xintAtLeastOne As Integer
Dim xcurFraction As Currency
Dim xstrDollarS As String, xstrBuildText As String
Const xcThousand = 1000@
Const xcMillion = xcThousand * xcThousand
Const xcBillion = xcThousand * xcMillion
Const xcTrillion = xcThousand * xcBillion
On Error Resume Next
xblnExact = False
xstrBuildText = ""
If (Int(Abs(curNumberValue)) = 0@) Then
xstrBuildText = "zero"
ElseIf (curNumberValue < 0@) Then
xstrBuildText = "negative "
End If
xcurFraction = Abs(curNumberValue - Fix(curNumberValue))
If (curNumberValue < 0@ Or xcurFraction <> 0@) Then curNumberValue = _
Abs(Fix(curNumberValue))
'xintAtLeastOne = (curNumberValue >= 1)
If (curNumberValue >= xcTrillion) Then
xstrBuildText = xstrBuildText & _
ConvertMoneyNumbersToText_DigitGroupToWord(Int(curNumberValue / _
xcTrillion)) & " trillion"
curNumberValue = curNumberValue - Int(curNumberValue / xcTrillion) * _
xcTrillion ' Mod overflows
If (curNumberValue >= 1@) Then xstrBuildText = xstrBuildText & " "
End If
If (curNumberValue >= xcBillion) Then
xstrBuildText = xstrBuildText & _
ConvertMoneyNumbersToText_DigitGroupToWord(Int(curNumberValue / _
xcBillion)) & " billion"
curNumberValue = curNumberValue - Int(curNumberValue / xcBillion) * _
xcBillion ' Mod still overflows
If (curNumberValue >= 1@) Then xstrBuildText = xstrBuildText & " "
End If
If (curNumberValue >= xcMillion) Then
xstrBuildText = xstrBuildText & _
ConvertMoneyNumbersToText_DigitGroupToWord(curNumberValue \ _
xcMillion) & " million"
curNumberValue = curNumberValue Mod xcMillion
If (curNumberValue >= 1@) Then xstrBuildText = xstrBuildText & " "
End If
If (curNumberValue >= xcThousand) Then
xstrBuildText = xstrBuildText & _
ConvertMoneyNumbersToText_DigitGroupToWord(curNumberValue \ _
xcThousand) & " thousand"
curNumberValue = curNumberValue Mod xcThousand
If (curNumberValue >= 1@) Then xstrBuildText = xstrBuildText & " "
End If
If (curNumberValue >= 1@) Then
xstrBuildText = xstrBuildText & _
ConvertMoneyNumbersToText_DigitGroupToWord(curNumberValue)
End If
If (xcurFraction = 0@) Then
xblnExact = True
ElseIf (Int(xcurFraction * 100@) = xcurFraction * 100@) Then
' If xintAtLeastOne Then xstrBuildText = xstrBuildText & " and "
xstrBuildText = xstrBuildText & " and "
xstrBuildText = xstrBuildText & Format$(xcurFraction * 100@, "00") & _
"/100"
Else
' If xintAtLeastOne Then xstrBuildText = xstrBuildText & " and "
xstrBuildText = xstrBuildText & " and "
xstrBuildText = xstrBuildText & Format$(xcurFraction * 10000@, "0000") &
_
"/10000"
End If
If Abs(curNumberValue) <= 1 And curNumberValue <> 0 And xblnExact = True
Then
xstrDollarS = "dollar"
ElseIf Abs(curNumberValue) < 1 And Abs(xcurFraction) > 0 Then
xstrDollarS = "dollar"
Else
xstrDollarS = "dollars"
End If
xstrBuildText = xstrBuildText & " " & xstrDollarS
If xblnExact = True Then xstrBuildText = xstrBuildText & " exactly"
ConvertMoneyNumbersToText = UCase(xstrBuildText)
Err.Clear
End Function
' *********************************************************
' ** Function ConvertMoneyNumbersToText_DigitGroupToWord **
' *********************************************************
Public Function ConvertMoneyNumbersToText_DigitGroupToWord(ByVal xintDigits
As _
Integer) As String
'This code was originally written by Joe Foster.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Joe Foster
'
'Modified by Ken Snell 15 May 2005
' *** THIS FUNCTION CONVERTS A NUMERIC VALUE INTO THE WORD THAT REPRESENTS
' *** THE NUMERIC VALUE. THIS FUNCTION IS CALLED BY THE
' *** ConvertMoneyNumbersToText FUNCTION.
Dim xstrBuild As String
Dim xblnFlag As Boolean
Const xcHundred = " hundred"
Const xcOne = "one"
Const xcTwo = "two"
Const xcThree = "three"
Const xcFour = "four"
Const xcFive = "five"
Const xcSix = "six"
Const xcSeven = "seven"
Const xcEight = "eight"
Const xcNine = "nine"
On Error Resume Next
xstrBuild = ""
xblnFlag = False
'Do hundreds
Select Case (xintDigits \ 100)
Case 0
xstrBuild = "": xblnFlag = False
Case 1
xstrBuild = xcOne & xcHundred: xblnFlag = True
Case 2
xstrBuild = xcTwo & xcHundred: xblnFlag = True
Case 3
xstrBuild = xcThree & xcHundred: xblnFlag = True
Case 4
xstrBuild = xcFour & xcHundred: xblnFlag = True
Case 5
xstrBuild = xcFive & xcHundred: xblnFlag = True
Case 6
xstrBuild = xcSix & xcHundred: xblnFlag = True
Case 7
xstrBuild = xcSeven & xcHundred: xblnFlag = True
Case 8
xstrBuild = xcEight & xcHundred: xblnFlag = True
Case 9
xstrBuild = xcNine & xcHundred: xblnFlag = True
End Select
If (xblnFlag <> False) Then xintDigits = xintDigits Mod 100
If (xintDigits > 0) Then
If (xblnFlag <> False) Then xstrBuild = xstrBuild & " "
Else
ConvertMoneyNumbersToText_DigitGroupToWord = xstrBuild
Exit Function
End If
'Do tens (except teens)
Select Case (xintDigits \ 10)
Case 0, 1
xblnFlag = False
Case 2
xstrBuild = xstrBuild & "twenty": xblnFlag = True
Case 3
xstrBuild = xstrBuild & "thirty": xblnFlag = True
Case 4
xstrBuild = xstrBuild & "forty": xblnFlag = True
Case 5
xstrBuild = xstrBuild & "fifty": xblnFlag = True
Case 6
xstrBuild = xstrBuild & "sixty": xblnFlag = True
Case 7
xstrBuild = xstrBuild & "seventy": xblnFlag = True
Case 8
xstrBuild = xstrBuild & "eighty": xblnFlag = True
Case 9
xstrBuild = xstrBuild & "ninety": xblnFlag = True
End Select
If (xblnFlag <> False) Then xintDigits = xintDigits Mod 10
If (xintDigits > 0) Then
If (xblnFlag <> False) Then xstrBuild = xstrBuild & "-"
Else
ConvertMoneyNumbersToText_DigitGroupToWord = xstrBuild
Exit Function
End If
'Do ones and teens
Select Case xintDigits
Case 0
' do nothing
Case 1
xstrBuild = xstrBuild & xcOne
Case 2
xstrBuild = xstrBuild & xcTwo
Case 3
xstrBuild = xstrBuild & xcThree
Case 4
xstrBuild = xstrBuild & xcFour
Case 5
xstrBuild = xstrBuild & xcFive
Case 6
xstrBuild = xstrBuild & xcSix
Case 7
xstrBuild = xstrBuild & xcSeven
Case 8
xstrBuild = xstrBuild & xcEight
Case 9
xstrBuild = xstrBuild & xcNine
Case 10
xstrBuild = xstrBuild & "ten"
Case 11
xstrBuild = xstrBuild & "eleven"
Case 12
xstrBuild = xstrBuild & "twelve"
Case 13
xstrBuild = xstrBuild & "thirteen"
Case 14
xstrBuild = xstrBuild & "fourteen"
Case 15
xstrBuild = xstrBuild & "fifteen"
Case 16
xstrBuild = xstrBuild & "sixteen"
Case 17
xstrBuild = xstrBuild & "seventeen"
Case 18
xstrBuild = xstrBuild & "eighteen"
Case 19
xstrBuild = xstrBuild & "nineteen"
End Select
ConvertMoneyNumbersToText_DigitGroupToWord = xstrBuild
Err.Clear
End Function
