em kiếm được đoạn code này (theo Ngọc Thanh-vnexpress) khá chuẩn cho 3 font chữ nhưng cuối dòng đọc không có chữ "đồng" có anh chị nào giúp em được không (thêm chữ "đồng" vào cuối)
*Ghi chú:
A2 = NumberToText(A1,0) 'Hàm định dạng Font Windows-VNI (Vni-Times)
A2=NumberToText(A1,1) 'Hàm định dạng Font ABC (VNTimes)
A2=NumberToText(A1,2) 'Hàm định dạng Font Unicode (Tahoma)
Public Enum Font_Codes
Font_VNI = 0
Font_ABC = 1
Font_Unicode = 2
End Enum
Public Function NumberToText(ByVal varVal As Variant, Optional ByVal Code As Font_Codes) As String
On Error GoTo Pro_Err
Static sDVs(0 To 15) As String
Static sDVNs(0 To 9) As String
Dim strErr As String
Dim sTens As String
Dim sHundred As String
Dim strDong As String
Dim strDolla As String
Dim sVal As String
Dim iVal As Integer
Dim i As Integer
Dim iCol As Integer
Dim iChar As Integer
Dim sTemp As String
Dim iScan As Integer
Dim strCurrency As String
Select Case Code
Case 0
sDVs(0) = " khoâng"
sDVs(1) = " moät"
sDVs(2) = " hai"
sDVs(3) = " ba"
sDVs(4) = " boán"
sDVs(5) = " naêm"
sDVs(6) = " saùu"
sDVs(7) = " baûy"
sDVs(8) = " taùm"
sDVs(9) = " chín"
sDVs(10) = " möôøi"
sDVs(11) = " moát"
sDVs(12) = " leû"
sDVs(13) = ""
sDVs(14) = " tö"
sDVs(15) = " laêm"
sDVNs(0) = ""
sDVNs(1) = " nghìn,"
sDVNs(2) = " trieäu,"
sDVNs(3) = " tyû,"
sDVNs(4) = " nghìn tyû,"
sDVNs(5) = " trieäu tyû,"
sDVNs(6) = " tyû tyû,"
sDVNs(7) = " nghìn tyû tyû,"
sDVNs(8) = " trieäu tyû tyû,"
sDVNs(9) = " tyû tyû tyû,"
strErr = " Loãi nhaäp!"
strEven = " chaün"
sHundred = " traêm"
sTens = " möôi"
strDong = " ñoàng"
strDolla = " ñoâ la"
Case 1
sDVs(0) = " kh«ng"
sDVs(1) = " mét"
sDVs(2) = " hai"
sDVs(3) = " ba"
sDVs(4) = " bèn"
sDVs(5) = " n¨m"
sDVs(6) = " s¸u"
sDVs(7) = " b¶y"
sDVs(8) = " t¸m"
sDVs(9) = " chÝn"
sDVs(10) = " mêi"
sDVs(11) = " mèt"
sDVs(12) = " lÎ"
sDVs(13) = ""
sDVs(14) = " t"
sDVs(15) = " l¨m"
sDVNs(0) = ""
sDVNs(1) = " ngh×n,"
sDVNs(2) = " triÖu,"
sDVNs(3) = " tû,"
sDVNs(4) = " ngh×n tû,"
sDVNs(5) = " triÖu tû,"
sDVNs(6) = " tû tû,"
sDVNs(7) = " ngh×n tû tû,"
sDVNs(8) = " triÖu tû tû,"
sDVNs(9) = " tû tû tû,"
strErr = " Lçi nhËp!"
strEven = " ch½n"
sHundred = " tr¨m"
sTens = " m¬i"
strDong = " ®ång"
strDolla = " ®« la"
Case 2
sDVs(0) = " kh" & ChrW$(&HF4) & "ng"
sDVs(1) = " m" & ChrW$(&H1ED9) & "t"
sDVs(2) = " hai"
sDVs(3) = " ba"
sDVs(4) = " b" & ChrW$(&H1ED1) & "n"
sDVs(5) = " n" & ChrW$(&H103) & "m"
sDVs(6) = " s" & ChrW$(&HE1) & "u"
sDVs(7) = " b" & ChrW$(&H1EA3) & "y"
sDVs(8) = " t" & ChrW$(&HE1) & "m"
sDVs(9) = " ch" & ChrW$(&HED) & "n"
sDVs(10) = " m" & ChrW$(&H1B0) & ChrW$(&H1EDD) & "i"
sDVs(11) = " m" & ChrW$(&H1ED1) & "t"
sDVs(12) = " l" & ChrW$(&H1EBB)
sDVs(13) = ""
sDVs(14) = " t" & ChrW$(&H1B0)
sDVs(15) = " l" & ChrW$(&H103) & "m"
sDVNs(0) = ""
sDVNs(1) = " ngh" & ChrW$(&HEC) & "n,"
sDVNs(2) = " tri" & ChrW$(&H1EC7) & "u,"
sDVNs(3) = " t" & ChrW$(&H1EF7) & ","
sDVNs(4) = " ngh" & ChrW$(&HEC) & "n" & " t" & ChrW$(&H1EF7) & ","
sDVNs(5) = " tri" & ChrW$(&H1EC7) & "u" & " t" & ChrW$(&H1EF7) & ","
sDVNs(6) = " t" & ChrW$(&H1EF7) & " t" & ChrW$(&H1EF7) & ","
sDVNs(7) = " ngh" & ChrW$(&HEC) & "n" & " t" & ChrW$(&H1EF7) & " t" & ChrW$(&H1EF7) & ","
sDVNs(8) = " tri" & ChrW$(&H1EC7) & "u" & " t" & ChrW$(&H1EF7) & " t" & ChrW$(&H1EF7) & ","
sDVNs(9) = " t" & ChrW$(&H1EF7) & " t" & ChrW$(&H1EF7) & " t" & ChrW$(&H1EF7) & ","
strErr = " L" & ChrW$(&H1ED7) & "i" & " nh" & ChrW$(&H1EAD) & "p!"
strEven = " ch" & ChrW$(&H1EB5) & "n"
sHundred = " tr" & ChrW$(&H103) & "m"
sTens = " m" & ChrW$(&H1B0) & ChrW$(&H1A1) & "i"
strDong = " " & ChrW$(&H111) & ChrW$(&H1ED3) & "ng"
strDolla = " " & ChrW$(&H111) & ChrW$(&HF4) & " la"
End Select
For iScan = 1 To Len(varVal)
If IsNumeric(Mid$(varVal, iScan, 1)) Then
sVal = sVal & Mid$(varVal, iScan, 1)
ElseIf Mid$(varVal, iScan, 1) = "$" Or UCase(Mid$(varVal, iScan, 3)) = "USA" Then
strCurrency = strDolla
ElseIf LCase(Mid$(varVal, iScan, Len("ñ"))) = "ñ" Or _
LCase(Mid$(varVal, iScan, Len("d"))) = "d" Or _
LCase(Mid$(varVal, iScan, Len("vnd"))) = "vnd" Or _
LCase(Mid$(varVal, iScan, 1)) = ChrW$(&H111) Or _
LCase(Mid$(varVal, iScan, Len("®"))) = "®" Then
strCurrency = strDong
End If
Next iScan
iVal = Len(sVal)
If iVal > 0 And iVal < 15 Then
sTemp = strCurrency
For i = iVal To 1 Step -1
iChar = Val(Mid$(sVal, i, 1))
iCol = iVal - (i - 1)
Select Case (iCol Mod 3)
Case 1
If iChar = 0 And iVal > 1 Then
If iVal = iCol + 1 Then
If Mid$(sVal, i - 1, 1) <> "0" Then
sTemp = sDVNs(iCol \ 3) & sTemp
End If
ElseIf iVal > iCol + 1 Then
If Val(Mid$(sVal, i - 2, 2)) > 0 Then
sTemp = sDVNs(iCol \ 3) & sTemp
End If
Else
sTemp = sTemp
End If
Else
If iChar = 1 And iVal > iCol Then
If Val(Mid$(sVal, i - 1, 1)) > 1 Then
iChar = 11
End If
ElseIf iChar = 4 And iVal > iCol Then
If Val(Mid$(sVal, i - 1, 1)) > 1 Then
iChar = 14
End If
ElseIf iChar = 5 And iVal > iCol Then
If Val(Mid$(sVal, i - 1, 1)) > 0 Then
iChar = 15
End If
End If
sTemp = sDVs(iChar) & sDVNs(iCol \ 3) & sTemp
End If
Case 2
If iChar > 1 Then
sTemp = sDVs(iChar) & sTens & sTemp
Else
If iChar = 1 Then
iChar = 10
ElseIf iChar = 0 And (Mid$(sVal, i + 1, 1) <> "0") Then
iChar = 12
Else
iChar = 13
End If
sTemp = sDVs(iChar) & sTemp
End If
Case 0
If iChar = 0 And ((Mid$(sVal, i + 1, 1) = "0") And (Mid$(sVal, i + 2, 1) = "0")) Then
sTemp = sTemp
Else
sTemp = sDVs(iChar) & sHundred & sTemp
End If
End Select
Next i
ElseIf iVal = 0 Then
sTemp = ""
End If
sTemp = Trim(sTemp)
If Right$(sTemp, 1) = "," Then
sTemp = Mid$(sTemp, 1, Len(sTemp) - 1)
End If
NumberToText = UCase$(Left$(sTemp, 1)) & Mid$(sTemp, 2)
Pro_Next:
Exit Function
Pro_Err:
GoTo Pro_Next
End Function
.
