Public Function Doiso(ByVal So_tien As Double, Optional ByVal Loai_tien As String = "®ång") As String
On Error GoTo ErrorHandle
Const cstMaxNumber = 999999999999999#
Const cstMaxDecimalNumber = 9999999999999.99
If So_tien > cstMaxNumber Then
Doiso = ""
Exit Function
End If
If (So_tien - Round(So_tien, 0) <> 0) And Loai_tien <> "VND" Then
If So_tien > cstMaxDecimalNumber Then
Doiso = ""
Exit Function
End If
End If
Dim sUnit As String
Dim sAfterUnit As String
sUnit = ""
sAfterUnit = ""
Select Case Loai_tien
Case "VND", "®ång"
sUnit = "®ång"
sAfterUnit = "xu"
Case "USD"
sUnit = "®« la Mü"
sAfterUnit = "xen"
Case "EUR"
sUnit = "euro"
Case "FRF"
sUnit = "phê r¨ng"
sAfterUnit = "xi linh"
Case "JPY"
sUnit = "yªn"
Case "GBP"
sUnit = "b¶ng"
sAfterUnit = "pence"
Case "CNY"
sUnit = "nh©n d©n tÖ"
Case Else
sUnit = Loai_tien
End Select
If Loai_tien = "VND" Then
So_tien = Abs(Round(So_tien, 0))
Else
So_tien = Abs(Round(So_tien, 2))
End If
'Define some useful mem-var for translating
Dim zk(1 To 9) As String
Dim zd(1 To 18) As String
Dim ttien As String, zkt As String, zv As String
Dim zi As Integer, zj As Integer, i As Integer
zk(1) = "mét"
zk(2) = "hai"
zk(3) = "ba"
zk(4) = "bèn"
zk(5) = "n¨m"
zk(6) = "s¸u"
zk(7) = "b¶y"
zk(8) = "t¸m"
zk(9) = "chin"
zd(15) = sUnit
zd(18) = sAfterUnit
zd(6) = "tû"
zd(9) = "triÖu"
For i = 3 To 12 Step 9
zd(i) = "ngh×n"
Next
For i = 1 To 13 Step 3
zd(i) = "tr¨m"
Next
For i = 2 To 17 Step 3
zd(i) = "m­¬i"
Next
ttien = " "
zkt = CStr(Format(So_tien, "#.00"))
For i = 1 To 18 - Len(zkt)
zkt = " " & zkt
Next
zi = 19 - Len(LTrim(zkt))
'Translating
Do While zi < 19
zv = Mid(zkt, zi, 1)
If InStr(1, "0123456789", zv, vbTextCompare) And zv <> "" Then
zj = CInt(LTrim(CStr(zi)))
If zv = "0" Then
If (zi = 13 Or zi = 10 Or zi = 7 Or zi = 4 Or zi = 1) And (Val(Mid(zkt, zi + 1, 1)) <> 0 Or Val(Mid(zkt, zi + 2, 1)) <> 0) Then
ttien = ttien + " kh«ng tr¨m"
If Mid(zkt, zi + 1, 1) = "0" Then
ttien = ttien + " linh"
End If
ElseIf zi = 18 And Val(Mid(zkt, 17, 1)) > 0 Then
ttien = ttien + " " & sAfterUnit
ElseIf zd(zj) = "m­¬i" And Val(Mid(zkt, zi + 1, 1)) > 0 And Val(Mid(zkt, IIf(zi > 1, zi - 1, 19), 1)) > 0 Then
ttien = ttien + " linh"
ElseIf zi = 6 Or (zi = 15 And So_tien >= 1) Or ((zi = 3 Or zi = 9 Or zi = 12) And Mid(zkt, IIf(zi > 2, zi - 2, 19), 2) <> "00") Then
ttien = ttien + " " + zd(zj)
End If
ElseIf zv = "1" And zd(zj) = "m­¬i" Then
ttien = ttien + " m­êi"
ElseIf zv = "5" And Val(Mid(zkt, IIf(zi > 1, zi - 1, 19), 1)) > 0 And (zi = 3 Or zi = 6 Or zi = 9 Or zi = 12 Or zi = 15 Or zi = 18) Then
ttien = ttien + " l¨m " + zd(zj)
Else
ttien = ttien + " " + zk(CInt(zv)) + " " + zd(zj)
End If
End If
zi = zi + 1
Loop
ttien = Replace(ttien, "m­¬i mét", "m­¬i mèt", , , vbTextCompare)
ttien = Replace(ttien, "m­¬i bèn", "m­¬i t­", , , vbTextCompare)
ttien = UCase(Mid(ttien, 3, 1)) + Mid(ttien, 4)
If Int(So_tien) - So_tien = 0 Then
ttien = ttien + " ch½n"
End If
Doiso = ttien
Exit Function
ErrorHandle:
Doiso = ""
Err.Clear
End Function
