Đổi số thành chữ với font UniCode

[phontan]

Mình có làm một AddIn cho Excel dùng với bảng mã UniCode, đọc tối đa 15 ký tự số. Bạn nào cần tải về dùng có gì vướng mắc cùng nhau thảo luận, tên hàm mình đã đặt như tên file.
Link tải : http://www.megaupload.com/?d=JN90DKJ3
Thông cảm nhé vì mình không biết up trong Forum.

Dưới đây là CODE :
Public Function ChuUni(ByVal sNum As String, Optional mDong As Boolean = True) As String
On Error Resume Next
Dim arSNum(1 To 9) As String
Dim arN(32) As Byte 'Chua gia tri cua cac chu so trong chuoi
Dim i As Byte, j As Byte, k As Byte, len_ As Byte
Dim S As String
Dim stop_ As Boolean

If Len(Trim(sNum)) = 0 Then
ChuUni = "Không "
Exit Function
End If

arSNum(1) = "m" & ChrW(7897) & "t "
arSNum(2) = "hai "
arSNum(3) = "ba "
arSNum(4) = "b" & ChrW(7889) & "n "
arSNum(5) = "n" & ChrW(259) & "m "
arSNum(6) = "sáu "
arSNum(7) = "b" & ChrW(7843) & "y "
arSNum(8) = "tám "
arSNum(9) = "chín "
S = ""
sNum = dotTrim(sNum)
stop_ = True
'Kiem tra co phai la chuoi so <> 0 hay khong
For i = 1 To Len(sNum)
If Mid(sNum, i, 1) <> "0" Then stop_ = False
Next i

If stop_ Then
ChuUni = ""
Exit Function
End If
'Kiem tra co phai la chuoi so hay khong
For i = 1 To Len(sNum)
If (Asc(Mid(sNum, i, 1)) < Asc("0") Or Asc(Mid(sNum, i, 1)) > Asc("9")) And (Mid(sNum, i, 1) <> ".") Then Exit Function
Next i
'Loai bo cac so 0 ben trai chuoi
sNum = killLeftZero(sNum)
len_ = Len(sNum)
'Chuyen doi moi chu so thanh so: "9" -> 9 va gan vao mang
For i = 1 To len_
arN(i) = Asc(Mid(sNum, i, 1)) - Asc("0")
Next i
'Thuat toan: Phan chuoi so thanh tung nhom gom 3 chu so: "5676435898608"-> "5.676.435.898.608"
For i = 1 To len_ ' do begin
k = len_ - i + 1
'Chu so o vi tri hang tram (tram, tram ngan,...)=0 va hai chu so ke tiep <>0 thi doc la "khong"
If (k Mod 3 = 0) And (arN(i) = 0) And ((arN(i + 1) <> 0) Or (arN(i + 2) <> 0)) Then
S = S + "không "
End If
'Chu so khong phai la chu so dac biet ("0", "1", "5") thi doc binh thuong
If (arN(i) <> 0) And (arN(i) <> 1) And (arN(i) <> 5) Then S = S + arSNum(arN(i))
'Chu so la "5"
If arN(i) = 5 Then
'Chu so o vi tri cuoi cua mot nhom va chu so ke truoc <>0 thi doc la "lam"
If (i > 0) And (k Mod 3 = 1) And (arN(i - 1) <> 0) Then
S = S + "l" & ChrW(259) & "m "
'neu khong thi doc la "nam"
Else: S = S + "n" & ChrW(259) & "m "
End If
End If
'Chu so o vi tri cuoi cua mot nhom la "1" nhung khong o dau chuoi va chu so ke truoc > 1 thi doc la "mo^'t"
If (i > 1) And (arN(i) = 1) And (k Mod 3 = 1) And (arN(i - 1) > 1) Then
S = S + "m" & ChrW(7889) & "t "
ElseIf (k Mod 3 <> 2) And (arN(i) = 1) Then S = S + "m" & ChrW(7897) & "t " 'neu khong, doc la "mo^.t"
End If

'Chu so o vi tri giua cua mot nhom nhung <> "0" va <> "1" thi doc binh thuong + "muoi"
If (k Mod 3 = 2) And (arN(i) <> 0) And (arN(i) <> 1) Then
S = S + "m" & ChrW(432) & "" & ChrW(417) & "i "
ElseIf (k Mod 3 = 2) And (arN(i) <> 0) Then S = S + "m" & ChrW(432) & "" & ChrW(7901) & "i " 'neu khong, doc la "muo`i"
End If

'Chu so la "0" nhung o vi tri giua cua mot nhom va chu so ke sau <>"0" thi doc la "le"
If (k Mod 3 = 2) And (arN(i) = 0) And (arN(i + 1) <> 0) Then S = S + "l" & ChrW(7867) & " "
'Chu so la "0" nhung o vi tri dau nhom va chu so ke sau la "0" thi doc la "khong"
If (k Mod 3 = 0) And (arN(i) = 0) And (arN(i + 1) = 0) _
And (arN(i + 2) = 0) Then S = S + "không "

'Chu so o vi tri dau nhom thi doc binh thuong + "tram"
If (k Mod 3 = 0) Then S = S + "tr" & ChrW(259) & "m "
'Chu so o vi tri cuoi nhom thi doc binh thuong + phan mo ta cho vi tri hang cua no ("nghin", "trieu", "ty",...)
Select Case k
Case 4: S = S + "ngàn "
Case 7: S = S + "tri" & ChrW(7879) & "u "
Case 10: S = S + "t" & ChrW(7927) & " "
Case 13: S = S + "ngàn t" & ChrW(7927) & " "
Case 16: S = S + "tri" & ChrW(7879) & "u t" & ChrW(7927) & " "
Case 19: S = S + "t" & ChrW(7927) & " t" & ChrW(7927) & " "
Case 22: S = S + "ngàn t" & ChrW(7927) & " t" & ChrW(7927) & " "
Case 25: S = S + "tri" & ChrW(7879) & "u t" & ChrW(7927) & " t" & ChrW(7927) & " "
Case 28: S = S + "t" & ChrW(7927) & " t" & ChrW(7927) & " t" & ChrW(7927) & " "
End Select

'Kiem tra truong hop dac biet , neu co mot chu so o vi tri cuoi nhom ma tat ca cac chu so dung sau la "0" thi khong doc nua
If (k Mod 3 = 1) Then
stop_ = True
For j = i + 1 To len_
If arN(j) <> 0 Then stop_ = False
Next j
If stop_ Then Exit For
End If
Next i
S = UCase(Left(S, 1)) + Right(S, Len(S) - 1)
If mDong Then S = S & "" & ChrW(273) & "" & ChrW(7891) & "ng."
ChuUni = S
End Function

 

[Bình_OverAC]

Đọc số thành chữ theo font Unicode đã có nhiều bác thực hiện. Bạn có thể tìm thấy nó trong thư viện. Ngoài ra nếu bạn muốn upload file cho mọi người tham khảo xin cứ gởi cho tôi. Tôi sẽ giúp bạn: donguyenbinh@gmail.com, bạn nhớ để link topic này để tôi biết nhé.