Option Explicit
Private m_dicNums As Dictionary
Private m_lngHundreds As Long
Private m_lngLast As Long
Private m_strBigUnit As String
Private m_strSmallUnit As String
Public Function Num2Words(varAmount As Variant, _
strBigUnit As String, _
strSmallUnit As String)
Dim strRv As String
Dim objRe As RegExp
Dim objMatches As MatchCollection
Dim strNum As String
Dim lngSignificance As Long
Dim strTemp As String
Dim dblAmount As Double
Set objRe = New RegExp
FillDic
m_strBigUnit = strBigUnit
m_strSmallUnit = strSmallUnit
If IsNumeric(varAmount) Then
dblAmount = Abs(CDbl(Round(varAmount, 2)))
If dblAmount > 0 Then
strNum = CStr(dblAmount)
objRe.Pattern = "[^\d\.]"
strNum = objRe.Replace(strNum, "")
objRe.Pattern = "(\d*)\.(\d+)$"
Set objMatches = objRe.Execute(strNum)
If objMatches.Count = 1 Then
strRv = ConvertPart(objMatches(0).SubMatches(1), -1) & " " & strSmallUnit
strNum = objMatches(0).SubMatches(0)
If CLng(strNum) = 0 Then
strRv = Right(strRv, Len(strRv) - 4)
End If
End If
If CLng(strNum) > 0 Then
lngSignificance = 1
Do
strTemp = ConvertPart(CStr(CLng(Right(strNum, 3))), lngSignificance)
If strTemp <> "" And Left(strRv, 1) <> " " Then
strRv = strTemp & " " & strRv
ElseIf strTemp <> "" Then
strRv = strTemp & strRv
End If
If Len(strNum) - 3 < 1 Then
Exit Do
End If
strNum = Left(strNum, Len(strNum) - 3)
lngSignificance = lngSignificance * 1000
Loop
strNum = CStr(dblAmount)
strRv = Trim(strRv)
If strNum = "1" Or Left(strNum, 2) = "1." Then
objRe.Pattern = strBigUnit
strRv = objRe.Replace(strRv, Left(strBigUnit, Len(strBigUnit) - 1))
End If
End If
Else
strRv = "zero"
End If
Else
strRv = "Could not convert"
End If
Set objMatches = Nothing
Set objRe = Nothing
Num2Words = strRv
End Function
Private Function ConvertPart(strNum As String, lngSignificance As Long) As String
Dim strRv As String
Select Case lngSignificance
Case -1
If Len(strNum) = 1 Then
strRv = "and " & ConvertNum(strNum & "0")
Else
strRv = "and " & ConvertNum(strNum)
End If
Case 1
If ConvertNum(strNum) <> "" Then
strRv = ConvertNum(strNum) & " " & m_strBigUnit
Else
strRv = m_strBigUnit
End If
m_lngHundreds = CLng(strNum)
m_lngLast = m_lngHundreds
Case 1000
If ConvertNum(strNum) <> "" Then
strRv = ConvertNum(strNum) & " " & m_dicNums(lngSignificance)
End If
If m_lngHundreds < 100 And m_lngHundreds <> 0 Then
strRv = strRv & " and"
ElseIf m_lngHundreds >= 100 Then
strRv = strRv & ","
End If
m_lngLast = CLng(strNum)
Case Else
If ConvertNum(strNum) <> "" Then
strRv = ConvertNum(strNum) & " " & m_dicNums(lngSignificance)
If m_lngLast <> 0 Then
strRv = strRv & ","
End If
End If
m_lngLast = CLng(strNum)
End Select
ConvertPart = strRv
End Function
Private Function ConvertNum(strNum As String) As String
Dim strRv As String
If CLng(strNum) > 0 Then
Select Case Len(strNum)
Case 1
strRv = m_dicNums(CLng(strNum))
Case 2
If m_dicNums.Exists(CLng(strNum)) Then
strRv = m_dicNums(CLng(strNum))
Else
strRv = m_dicNums(CLng(Left(strNum, 1) & "0")) & "-" & m_dicNums(CLng(Right(strNum, 1)))
End If
Case 3
If m_dicNums.Exists(CLng(strNum)) Then
strRv = "one " & m_dicNums(CLng(strNum))
Else
strRv = m_dicNums(CLng(Left(strNum, 1))) & " hundred"
If CLng(Right(strNum, 2)) > 0 Then
If m_dicNums.Exists(CLng(Right(strNum, 2))) Then
strRv = strRv & " and " & m_dicNums(CLng(Right(strNum, 2)))
Else
strRv = strRv & " and " & m_dicNums(CLng(Mid(strNum, 2, 1) & "0")) & "-" & m_dicNums(CLng(Right(strNum, 1)))
End If
End If
End If
End Select
End If
ConvertNum = strRv
End Function
Private Sub FillDic()
Set m_dicNums = New Dictionary
m_dicNums(0) = "zero"
m_dicNums(1) = "one"
m_dicNums(2) = "two"
m_dicNums(3) = "three"
m_dicNums(4) = "four"
m_dicNums(5) = "five"
m_dicNums(6) = "six"
m_dicNums(7) = "seven"
m_dicNums(8) = "eight"
m_dicNums(9) = "nine"
m_dicNums(10) = "ten"
m_dicNums(11) = "eleven"
m_dicNums(12) = "twelve"
m_dicNums(13) = "thirteen"
m_dicNums(14) = "fourteen"
m_dicNums(15) = "fifteen"
m_dicNums(16) = "sixteen"
m_dicNums(17) = "seventeen"
m_dicNums(18) = "eighteen"
m_dicNums(19) = "nineteen"
m_dicNums(20) = "twenty"
m_dicNums(30) = "thirty"
m_dicNums(40) = "forty"
m_dicNums(50) = "fifty"
m_dicNums(60) = "sixty"
m_dicNums(70) = "seventy"
m_dicNums(80) = "eighty"
m_dicNums(90) = "ninety"
m_dicNums(100) = "hundred"
m_dicNums(1000) = "thousand"
m_dicNums(1000000) = "million"
m_dicNums(1000000000) = "billion"
m_dicNums(1000000000000#) = "trillion"
End Sub
|