Code:
Private sNumberText() As String
Public Function AEDtext(NumberIn As Variant) As String
Dim cnt As Long
Dim DecimalPoint As Long
Dim CardinalNumber As Long
Dim CommaAdjuster As Long
Dim TestValue As Long
Dim CurrValue As Currency
Dim CentsString As String
Dim NumberSign As String
Dim WholePart As String
Dim BigWholePart As String
Dim DecimalPart As String
Dim tmp As String
Dim sStyle As String
Dim bUseAnd As Boolean
Dim bUseCheck As Boolean
Dim bUseDollars As Boolean
Dim bUseCheckDollar As Boolean
Dim AND_or_CHECK_or_DOLLAR_or_CHECKDOLLAR As String
'----------------------------------------
' Begin setting conditions for formatting
'----------------------------------------
sStyle = "dollar"
bUseAnd = sStyle = "and"
bUseDollars = sStyle = "dollar"
bUseCheck = (sStyle = "check") Or (sStyle = "dollar")
' bUseCheckDollar = sStyle = "checkdollar"
'----------------------------------------
' Check/create array. If this is the first
' time using this routine, create the text
' strings that will be used.
'----------------------------------------
If Not IsBounded(sNumberText) Then
Call BuildArray(sNumberText)
End If
'----------------------------------------
' Begin validating the number, and breaking
' into constituent parts
'----------------------------------------
NumberIn = Trim$(NumberIn)
If Not IsNumeric(NumberIn) Then
AEDtext = "Error - Number improperly formed"
Exit Function
Else
DecimalPoint = InStr(NumberIn, ".")
If DecimalPoint > 0 Then
DecimalPart = Mid$(NumberIn, DecimalPoint + 1)
WholePart = Left$(NumberIn, DecimalPoint - 1)
Else
DecimalPoint = Len(NumberIn) + 1
WholePart = NumberIn
End If
If InStr(NumberIn, ",,") Or _
InStr(NumberIn, ",.") Or _
InStr(NumberIn, ".,") Or _
InStr(DecimalPart, ",") Then
AEDtext = "Error - Improper use of commas"
Exit Function
ElseIf InStr(NumberIn, ",") Then
CommaAdjuster = 0
WholePart = ""
For cnt = DecimalPoint - 1 To 1 Step -1
If Not Mid$(NumberIn, cnt, 1) Like "[,]" Then
WholePart = Mid$(NumberIn, cnt, 1) & WholePart
Else
CommaAdjuster = CommaAdjuster + 1
If (DecimalPoint - cnt - CommaAdjuster) Mod 3 Then
AEDtext = "Error - Improper use of commas"
Exit Function
End If
End If
Next
End If
End If
If Left$(WholePart, 1) Like "[+-]" Then
NumberSign = IIf(Left$(WholePart, 1) = "-", "Minus ", "Plus ")
WholePart = Mid$(WholePart, 2)
End If
'----------------------------------------
' Begin code to assure decimal portion of
' check value is not inadvertently rounded
'----------------------------------------
If bUseCheck = True Then
CurrValue = CCur(Val("." & DecimalPart))
DecimalPart = Mid$(Format$(CurrValue, "0.00"), 3, 2)
If CurrValue >= 0.995 Then
If WholePart = String$(Len(WholePart), "9") Then
WholePart = "1" & String$(Len(WholePart), "0")
Else
For cnt = Len(WholePart) To 1 Step -1
If Mid$(WholePart, cnt, 1) = "9" Then
Mid$(WholePart, cnt, 1) = "0"
Else
Mid$(WholePart, cnt, 1) = _
CStr(Val(Mid$(WholePart, cnt, 1)) + 1)
Exit For
End If
Next
End If
End If
End If
'----------------------------------------
' Final prep step - this assures number
' within range of formatting code below
'----------------------------------------
If Len(WholePart) > 9 Then
BigWholePart = Left$(WholePart, Len(WholePart) - 9)
WholePart = Right$(WholePart, 9)
End If
If Len(BigWholePart) > 9 Then
AEDtext = "Error - Number too large"
Exit Function
ElseIf Not WholePart Like String$(Len(WholePart), "#") Or _
(Not BigWholePart Like String$(Len(BigWholePart), "#") _
And Len(BigWholePart) > 0) Then
AEDtext = "Error - Number improperly formed"
Exit Function
End If
'----------------------------------------
' Begin creating the output string
'----------------------------------------
' Very Large values
TestValue = Val(BigWholePart)
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = HundredsTensUnits(CardinalNumber) & "Quadrillion "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Trillion "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
tmp = tmp & HundredsTensUnits(TestValue) & "Billion "
End If
' Lesser values
TestValue = Val(WholePart)
If TestValue = 0 And BigWholePart = "" Then tmp = "Zero "
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Million "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Thousand "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
If Val(WholePart) < 99 And BigWholePart = "" Then bUseAnd = False
tmp = tmp & HundredsTensUnits(TestValue, bUseAnd)
End If
' If in dollar mode, assure the text is the correct plurality
If bUseDollars = True Then
CentsString = HundredsTensUnits(DecimalPart)
tmp = "AED " & tmp
If Len(CentsString) > 0 Then
tmp = tmp & "& " & CentsString
tmp = tmp & "Fils Only"
Else
tmp = tmp & "Only"
End If
End If
' Done!
AEDtext = NumberSign & tmp
End Function
Private Sub BuildArray(sNumberText() As String)
ReDim sNumberText(0 To 27) As String
sNumberText(0) = "Zero"
sNumberText(1) = "One"
sNumberText(2) = "Two"
sNumberText(3) = "Three"
sNumberText(4) = "Four"
sNumberText(5) = "Five"
sNumberText(6) = "Six"
sNumberText(7) = "Seven"
sNumberText(8) = "Eight"
sNumberText(9) = "Nine"
sNumberText(10) = "Ten"
sNumberText(11) = "Eleven"
sNumberText(12) = "Twelve"
sNumberText(13) = "Thirteen"
sNumberText(14) = "Fourteen"
sNumberText(15) = "Fifteen"
sNumberText(16) = "Sixteen"
sNumberText(17) = "Seventeen"
sNumberText(18) = "Eighteen"
sNumberText(19) = "Nineteen"
sNumberText(20) = "Twenty"
sNumberText(21) = "Thirty"
sNumberText(22) = "Forty"
sNumberText(23) = "Fifty"
sNumberText(24) = "Sixty"
sNumberText(25) = "Seventy"
sNumberText(26) = "Eighty"
sNumberText(27) = "Ninety"
End Sub
Private Function IsBounded(vntArray As Variant) As Boolean
On Error Resume Next
IsBounded = IsNumeric(UBound(vntArray))
End Function
Private Function HundredsTensUnits(ByVal TestValue As Integer, _
Optional bUseAnd As Boolean) As String
Dim CardinalNumber As Integer
If TestValue > 99 Then
CardinalNumber = TestValue \ 100
HundredsTensUnits = sNumberText(CardinalNumber) & " Hundred "
TestValue = TestValue - (CardinalNumber * 100)
End If
If bUseAnd = True Then
HundredsTensUnits = HundredsTensUnits & "and "
End If
If TestValue > 20 Then
CardinalNumber = TestValue \ 10
HundredsTensUnits = HundredsTensUnits & _
sNumberText(CardinalNumber + 18)
TestValue = TestValue - (CardinalNumber * 10)
End If
If TestValue > 0 Then
If Right(HundredsTensUnits, 1) <> " " Then HundredsTensUnits = HundredsTensUnits & "-"
HundredsTensUnits = HundredsTensUnits & sNumberText(TestValue) & " "
Else
HundredsTensUnits = HundredsTensUnits & " "
End If
If Left(HundredsTensUnits, 1) = "-" Then HundredsTensUnits = Mid(HundredsTensUnits, 2)
End Function
Amount to Words [EXCEL 2007]
Reply With Quote
Originally Posted by msiyab
Bookmarks