Just paste this code into any module and change the name to basConversions
'----------------------------------------------------------------------
'
' Module Name: basConversions
' Written By: C&D Programming Corp.
' Create Date: 2/2/98
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'
'
'----------------------------------------------------------------------
Option Explicit
' An array to hold the English equivalent to the various numbers.
Dim WordForNumber() As String
Private Sub InitWords()
' This is so we do not waste CPU cycles reinitializing this
' array each time NumToWords is called.
Static bInit As Boolean
If Not bInit Then
bInit = True
ReDim WordForNumber(1 To 90)
WordForNumber(1) = "One"
WordForNumber(2) = "Two"
WordForNumber(3) = "Three"
WordForNumber(4) = "Four"
WordForNumber(5) = "Five"
WordForNumber(6) = "Six"
WordForNumber(7) = "Seven"
WordForNumber(8) = "Eight"
WordForNumber(9) = "Nine"
WordForNumber(10) = "Ten"
WordForNumber(11) = "Eleven"
WordForNumber(12) = "Twelve"
WordForNumber(13) = "Thirteen"
WordForNumber(14) = "Fourteen"
WordForNumber(15) = "Fifteen"
WordForNumber(16) = "Sixteen"
WordForNumber(17) = "Seventeen"
WordForNumber(18) = "Eighteen"
WordForNumber(19) = "Nineteen"
WordForNumber(20) = "Twenty"
WordForNumber(30) = "Thirty"
WordForNumber(40) = "Fourty"
WordForNumber(50) = "Fifty"
WordForNumber(60) = "Sixty"
WordForNumber(70) = "Seventy"
WordForNumber(80) = "Eighty"
WordForNumber(90) = "Ninety"
End If
End Sub
'
' This routine converts a three digit number into its equivalent
' based on the information stored in the WordForNumber array.
'
Private Function PartialNumToWords(sVal As String, sSuffix As String) As String
Dim iVal As Integer
Dim iOnes As Integer
Dim sPrefix As String
Dim sWords As String
iVal = Val(sVal)
' this code processes numbers greater than 99.
If Left(sVal, 1) <> "0" Then
sPrefix = WordForNumber(Val(Left(sVal, 1))) & " Hundred"
Else
sPrefix = ""
End If
' We only want to look at the right two digits for this code.
iVal = Val(Right(sVal, 2))
Select Case iVal
Case 0
' if the value passed is exactly one hundred, we have
' to make sure that we add on the suffix to the
' hundreds if there was one.
If sPrefix = "" Then
sWords = ""
Else
sPrefix = sPrefix & " " & sSuffix
End If
Case 1 To 20
sWords = WordForNumber(iVal) & " " & sSuffix
Case 30, 40, 50, 60, 70, 80, 90
sWords = WordForNumber(iVal) & " " & sSuffix
Case Else
iOnes = Val(Right(sVal, 1))
iVal = iVal - iOnes
sWords = WordForNumber(iVal) & " " & _
WordForNumber(iOnes) & " " & sSuffix
End Select
sWords = Trim$(sWords)
If sWords = "" And sPrefix = "" Then
PartialNumToWords = ""
Else
PartialNumToWords = Trim$(sPrefix & " " & sWords) & " "
End If
End Function
Public Function NumToWords(ByVal dNum As Double) As String
Dim sNum As String
Dim sWords As String
Dim sCents As String
InitWords ' init the array of english words if necessary
' convert the number to a string for easier handling
sNum = Format(dNum, "000000000000.00")
' Call the PartialNumToWords multiple times to convert
' each group into its english equivalent
sWords = PartialNumToWords(Mid(sNum, 1, 3), "Billion") & _
PartialNumToWords(Mid(sNum, 4, 3), "Million") & _
PartialNumToWords(Mid(sNum, 7, 3), "Thousand") & _
PartialNumToWords(Mid(sNum, 10, 3), "")
sWords = Trim$(sWords)
' Make sure we do the cents (right of the decimal)
sCents = Trim$(PartialNumToWords("0" & Mid(sNum, 14, 2), "Cents"))
' cover the case when the cents are zero.
If sCents = "" Then
sCents = "Zero Cents"
End If
' cover the case when there are only cents
If sWords = "" Then
sWords = "Zero Dollars and " & sCents
Else
' make sure the dollar/s gets pluralized correctly.
If sWords = "One" Then
sWords = sWords & " Dollar and " & sCents
Else
sWords = sWords & " Dollars and " & sCents
End If
End If
NumToWords = sWords
End Function