|
Option Explicit
Private Type mtype
vall As Integer
loca As Integer
des As String
End Type
Private Type nType
value As Integer
location As Integer
strchange As String
downnumber As Integer
End Type
Dim mntype() As nType
Dim flag As Boolean
Dim FLAG1 As Boolean
Dim FLAG2 As Boolean
Dim FLAG3 As Boolean
Private Function translate(ByVal number As Long, Optional ByVal X As Integer) As String
Dim i As Integer
Dim str As String
Dim size As Integer
Dim strnumber As String
flag = False
FLAG1 = False
FLAG2 = False
FLAG3 = False
If X = 1 Then FLAG3 = True
strnumber = CStr(number)
size = Len(strnumber)
ReDim mntype(1 To size)
For i = 1 To size
mntype(i).value = Mid(strnumber, size - i + 1, 1)
mntype(i).location = i
If i > 1 Then
mntype(i).downnumber = mntype(i - 1).value
Else
mntype(i).downnumber = 0
End If
choice mntype(i).value, mntype(i).downnumber, mntype(i).location
Next i
For i = size To 1 Step -1
If mntype(i).value < 2 And mntype(i).location = 2 And mntype(i).value <> 0 Then
choice mntype(i).value * 10 + mntype(i).downnumber, mntype(i).downnumber, mntype(i).location
str = str & mntype(i).strchange
Exit For
End If
str = str & mntype(i).strchange
Next i
translate = str
End Function
Private Sub choice(ByVal value As Integer, ByVal downnumber As Integer, ByVal sx As Integer)
Dim str As String
Select Case sx
Case 1
If value = 0 Then
str = ""
FLAG1 = True
Else
str = choicenumber(value)
flag = True
End If
Case 2
If value = 0 Then
str = ""
FLAG2 = True
flag = False
ElseIf value >= 2 And value < 10 Then
str = choicenumber(value * 10)
Else
str = choicenumber(value)
End If
Case 3
If value = 0 Then
str = ""
ElseIf FLAG1 And FLAG2 And FLAG3 Then
str = choicenumber(value) & " " & "hundred" & " "
Else
str = choicenumber(value) & " " & "hundred and" & " "
End If
End Select
mntype(sx).strchange = str
End Sub
Private Function choicenumber(ByVal value As Integer) As String
Dim str As String
Select Case value
Case 1
str = "one"
Case 2
str = "two"
Case 3
str = "three"
Case 4
str = "four"
Case 5
str = "five"
Case 6
str = "six"
Case 7
str = "seven"
Case 8
str = "eight"
Case 9
str = "nine"
Case 10
str = "ten"
Case 11
str = "eleven"
Case 12
str = "twelve"
Case 13
str = "thirteen"
Case 14
str = "fourteen"
Case 15
str = "fifteen"
Case 16
str = "sixteen"
Case 17
str = "seventeen"
Case 18
str = "eighteen"
Case 19
str = "nineteen"
Case 20
str = "twenty"
Case 30
str = "thirty"
Case 40
str = "forty"
Case 50
str = "fifty"
Case 60
str = "sixty"
Case 70
str = "seventy"
Case 80
str = "eighty"
Case 90
str = "ninety"
End Select
If flag Then
choicenumber = str & "-"
flag = False
Else
choicenumber = str
End If
End Function
Public Function tran(ByVal X As Long) As String
Dim mmtype() As mtype
Dim i As Integer
Dim str As String
Dim circuit As Integer
circuit = IIf(Len(CStr(X)) Mod 3 = 0, Len(CStr(X)) \ 3, Len(CStr(X)) \ 3 + 1)
ReDim mmtype(1 To circuit) As mtype
Select Case circuit
Case 1
mmtype(1).vall = X
mmtype(1).loca = 1
mmtype(1).des = translate(X)
Case 2
mmtype(1).vall = Right(X, 3)
mmtype(1).loca = 1
mmtype(1).des = translate(mmtype(1).vall)
mmtype(2).vall = Mid(X, 1, Len(CStr(X)) - 3)
mmtype(2).loca = 2
mmtype(2).des = translate(mmtype(2).vall) & " " & "thousand"
End Select
For i = 1 To circuit
str = mmtype(i).des & " " & str
Next i
tran = str
End Function |
|