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

Thảo luận trong 'Ứng dụng Excel' bắt đầu bởi phontan, 28 Tháng hai 2007.

6,304 lượt xem

  1. phontan

    phontan Thành viên sơ cấp

    Bài viết:
    1
    Đã được thích:
    0
    Nơi ở:
    Bạc Liêu
    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
     
    #1
  2. Bình_OverAC

    Bình_OverAC Over Abnormal / Crazy

    Bài viết:
    845
    Đã được thích:
    7
    Nơi ở:
    Nha Trang
    Đọ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é.
     
    #2

Chia sẻ trang này