Add-in: Đổi số sang chữ trong Excel sử dụng font Unicode

Liên hệ QC
Cho mình hỏi. Mình đang sử dụng window 8, excel 2010 vậy cách đổi số sang chữ mình làm như thế nào? Hướng dẫn mình với. Thanks bạn nhiều
 
Cho mình hỏi. Mình đang sử dụng window 8, excel 2010 vậy cách đổi số sang chữ mình làm như thế nào? Hướng dẫn mình với. Thanks bạn nhiều
Bạn tự học trên diễn đàn, có rất nhiều hướng dẫn.
Một ví dụ là bạn xem bài của mình ở ngay trên (bài #181)!
 
Từ phần nghìn chuyển qua thành triệu thì làm như thế nào?

Đây là hàm đổi số ra chữ cho 3 bảng mã :
Unicode: hàm DocSoUni
Vni Window: hàm DocSoVni
TCVN3 ABC: hàm DocSoAbc
Các bạn có thể tải tập tin DocsoVn.zip có sẳn 3 hàm trên.

Mã:
'=====================
Function DocSoVni(conso) As String
s09 = Array("", " moät", " hai", " ba", " boán", " naêm", " saùu", " baûy", " taùm", " chín")
lop3 = Array("", " trieäu", " nghìn", " tyû")
If Trim(conso) = "" Then
  DocSoVni = ""
ElseIf IsNumeric(conso) = True Then
  If conso < 0 Then dau = "aâm " Else dau = ""
  conso = Application.WorksheetFunction.Round(Abs(conso), 0)
  conso = " " & conso
  conso = Replace(conso, ",", "", 1)
  vt = InStr(1, conso, "E")
  If vt > 0 Then
    sonhan = Val(Mid(conso, vt + 1))
    conso = Trim(Mid(conso, 2, vt - 2))
    conso = conso & String(sonhan - Len(conso) + 1, "0")
  End If
  conso = Trim(conso)
  sochuso = Len(conso) Mod 9
  If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
  docso = ""
  i = 1
  lop = 1
  Do
    n1 = Mid(conso, i, 1)
    n2 = Mid(conso, i + 1, 1)
    n3 = Mid(conso, i + 2, 1)
    baso = Mid(conso, i, 3)
    i = i + 3
    If n1 & n2 & n3 = "000" Then
      If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " tyû" Else s123 = ""
    Else
      If n1 = 0 Then
        If docso = "" Then s1 = "" Else s1 = " khoâng traêm"
      Else
        s1 = s09(n1) & " traêm"
      End If
      If n2 = 0 Then
        If s1 = "" Or n3 = 0 Then
          s2 = ""
        Else
          s2 = " linh"
        End If
      Else
        If n2 = 1 Then s2 = " möôøi" Else s2 = s09(n2) & " möôi"
      End If
      If n3 = 1 Then
        If n2 = 1 Or n2 = 0 Then s3 = " moät" Else s3 = " moát"
      ElseIf n3 = 5 And n2 <> 0 Then
        s3 = " laêm"
      Else
        s3 = s09(n3)
      End If
      If i > Len(conso) Then
        s123 = s1 & s2 & s3
      Else
        s123 = s1 & s2 & s3 & lop3(lop)
      End If
    End If
    lop = lop + 1
    If lop > 3 Then lop = 1
    docso = docso & s123
    If i > Len(conso) Then Exit Do
  Loop
  If docso = "" Then DocSoVni = "khoâng" Else DocSoVni = dau & Trim(docso)
Else
  DocSoVni = conso
End If
End Function
'==================================
Function DocSoAbc(conso) As String
s09 = Array("", " mét", " hai", " ba", " bèn", " n¨m", " s¸u", " b¶y", " t¸m", " chÝn")
lop3 = Array("", " triÖu", " ngh×n", " tû", " triÖu", " ngh×n", "")
If Trim(conso) = "" Then
  DocSoAbc = ""
ElseIf IsNumeric(conso) = True Then
  If conso < 0 Then dau = "©m " Else dau = ""
  conso = Application.WorksheetFunction.Round(Abs(conso), 0)
  conso = " " & conso
  conso = Replace(conso, ",", "", 1)
  vt = InStr(1, conso, "E")
  If vt > 0 Then
    sonhan = Val(Mid(conso, vt + 1))
    conso = Trim(Mid(conso, 2, vt - 2))
    conso = conso & String(sonhan - Len(conso) + 1, "0")
  End If
  conso = Trim(conso)
  sochuso = Len(conso) Mod 9
  If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
  docso = ""
  i = 1
  lop = 1
  Do
    n1 = Mid(conso, i, 1)
    n2 = Mid(conso, i + 1, 1)
    n3 = Mid(conso, i + 2, 1)
    baso = Mid(conso, i, 3)
    i = i + 3
    If n1 & n2 & n3 = "000" Then
      If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " tû" Else s123 = ""
    Else
      If n1 = 0 Then
        If docso = "" Then s1 = "" Else s1 = " kh«ng tr¨m"
      Else
        s1 = s09(n1) & " tr¨m"
      End If
      If n2 = 0 Then
        If s1 = "" Or n3 = 0 Then
          s2 = ""
        Else
          s2 = " linh"
        End If
      Else
        If n2 = 1 Then s2 = " m­êi" Else s2 = s09(n2) & " m­¬i"
      End If
      If n3 = 1 Then
        If n2 = 1 Or n2 = 0 Then s3 = " mét" Else s3 = " mèt"
      ElseIf n3 = 5 And n2 <> 0 Then
        s3 = " l¨m"
      Else
        s3 = s09(n3)
      End If
      If i > Len(conso) Then
        s123 = s1 & s2 & s3
      Else
        s123 = s1 & s2 & s3 & lop3(lop)
      End If
    End If
    lop = lop + 1
    If lop > 3 Then lop = 1
    docso = docso & s123
    If i > Len(conso) Then Exit Do
  Loop
  If docso = "" Then DocSoAbc = "kh«ng" Else DocSoAbc = dau & Trim(docso)
Else
  DocSoAbc = conso
End If
End Function
'===============================
Function DocSoUni(conso) As String
s09 = Array("", " m" & ChrW(7897) & "t", " hai", " ba", " b"  & ChrW(7889) & "n", " n" & ChrW(259) & "m", " s" &  ChrW(225) & "u", " b" & ChrW(7843) & "y", " t" &  ChrW(225) & "m", " ch" & ChrW(237) & "n")
lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
'Stop
If Trim(conso) = "" Then
  DocSoUni = ""
ElseIf IsNumeric(conso) = True Then
  If conso < 0 Then dau = ChrW(226) & "m " Else dau = ""
  conso = Application.WorksheetFunction.Round(Abs(conso), 0)
  conso = " " & conso
  conso = Replace(conso, ",", "", 1)
  vt = InStr(1, conso, "E")
  If vt > 0 Then
    sonhan = Val(Mid(conso, vt + 1))
    conso = Trim(Mid(conso, 2, vt - 2))
    conso = conso & String(sonhan - Len(conso) + 1, "0")
  End If
  conso = Trim(conso)
  sochuso = Len(conso) Mod 9
  If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
  docso = ""
  i = 1
  lop = 1
  Do
    n1 = Mid(conso, i, 1)
    n2 = Mid(conso, i + 1, 1)
    n3 = Mid(conso, i + 2, 1)
    baso = Mid(conso, i, 3)
    i = i + 3
    If n1 & n2 & n3 = "000" Then
      If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
    Else
      If n1 = 0 Then
        If docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
      Else
        s1 = s09(n1) & " tr" & ChrW(259) & "m"
      End If
      If n2 = 0 Then
        If s1 = "" Or n3 = 0 Then
          s2 = ""
        Else
          s2 = " linh"
        End If
      Else
        If n2 = 1 Then s2 = " m" & ChrW(432) & ChrW(7901) &  "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) &  "i"
      End If
      If n3 = 1 Then
        If n2 = 1 Or n2 = 0 Then s3 = " m" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
      ElseIf n3 = 5 And n2 <> 0 Then
        s3 = " l" & ChrW(259) & "m"
      Else
        s3 = s09(n3)
      End If
      If i > Len(conso) Then
        s123 = s1 & s2 & s3
      Else
        s123 = s1 & s2 & s3 & lop3(lop)
      End If
    End If
    lop = lop + 1
    If lop > 3 Then lop = 1
    docso = docso & s123
    If i > Len(conso) Then Exit Do
  Loop
  If docso = "" Then DocSoUni = "kh" & ChrW(244) & "ng" Else DocSoUni = dau & Trim(docso)
Else
  DocSoUni = conso
End If
End Function

Mình có thắc mắc là:
mình toàn đánh số nghìn nhưng toàn lập trình là Increase ra thành triệu (VD: 1.000 -> 1.000.000) cả nên khi dùng hàm này nó chỉ nhận là nghìn thôi (vẫn 1.000)
Vậy phải làm thế nào?
Các pác giúp mình với!
Thanks,
 
Mình có thắc mắc là:
mình toàn đánh số nghìn nhưng toàn lập trình là Increase ra thành triệu (VD: 1.000 -> 1.000.000) cả nên khi dùng hàm này nó chỉ nhận là nghìn thôi (vẫn 1.000)
Vậy phải làm thế nào?
Các pác giúp mình với!
Thanks,
Không hiểu bạn muốn giúp gì?
Bạn đánh 1.000 thì đọc số ra chữ là Một nghìn đồng
Bạn đánh số 1.000.000 thì đọc số ra chữ là Một triệu đồng.
Không hiểu bạn muốn nhập số bao nhiêu?
 
Không hiểu bạn muốn giúp gì?
Bạn đánh 1.000 thì đọc số ra chữ là Một nghìn đồng
Bạn đánh số 1.000.000 thì đọc số ra chữ là Một triệu đồng.
Không hiểu bạn muốn nhập số bao nhiêu?
Ý của bạn ấy là đổi đơn vị thành "nghìn đồng" thay vì "đồng" như hiện tại!
VD: Khi đánh số 1.232 thì nó sẽ đọc là "Một triệu hai trăm ba mươi hai nghìn đồng". Cái này dễ ợt ý mà, thêm chữ "nghìn" vào trước chữ "đồng" trong tên đơn vị là xong!!
 
Chào mọi người,


Sao mình đã làm như vây rồi nhưng vẫn báo #NAME? vậy mọi người. Tks
 
Chào mọi người,


Sao mình đã làm như vây rồi nhưng vẫn báo #NAME? vậy mọi người. Tks
Chắc bạn chưa biết cách thêm add in vào excel rồi nên excel báo lỗi không hiểu hàm đó (#NAME).
Bạn tìm trên trên diễn đàn "cách thêm add in vào excel".
 
Đây là hàm đổi số ra chữ cho 3 bảng mã :
Unicode: hàm DocSoUni
Vni Window: hàm DocSoVni
TCVN3 ABC: hàm DocSoAbc
Các bạn có thể tải tập tin DocsoVn.zip có sẳn 3 hàm trên.

Mã:
'=====================
Function DocSoVni(conso) As String
s09 = Array("", " moät", " hai", " ba", " boán", " naêm", " saùu", " baûy", " taùm", " chín")
lop3 = Array("", " trieäu", " nghìn", " tyû")
If Trim(conso) = "" Then
  DocSoVni = ""
ElseIf IsNumeric(conso) = True Then
  If conso < 0 Then dau = "aâm " Else dau = ""
  conso = Application.WorksheetFunction.Round(Abs(conso), 0)
  conso = " " & conso
  conso = Replace(conso, ",", "", 1)
  vt = InStr(1, conso, "E")
  If vt > 0 Then
    sonhan = Val(Mid(conso, vt + 1))
    conso = Trim(Mid(conso, 2, vt - 2))
    conso = conso & String(sonhan - Len(conso) + 1, "0")
  End If
  conso = Trim(conso)
  sochuso = Len(conso) Mod 9
  If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
  docso = ""
  i = 1
  lop = 1
  Do
    n1 = Mid(conso, i, 1)
    n2 = Mid(conso, i + 1, 1)
    n3 = Mid(conso, i + 2, 1)
    baso = Mid(conso, i, 3)
    i = i + 3
    If n1 & n2 & n3 = "000" Then
      If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " tyû" Else s123 = ""
    Else
      If n1 = 0 Then
        If docso = "" Then s1 = "" Else s1 = " khoâng traêm"
      Else
        s1 = s09(n1) & " traêm"
      End If
      If n2 = 0 Then
        If s1 = "" Or n3 = 0 Then
          s2 = ""
        Else
          s2 = " linh"
        End If
      Else
        If n2 = 1 Then s2 = " möôøi" Else s2 = s09(n2) & " möôi"
      End If
      If n3 = 1 Then
        If n2 = 1 Or n2 = 0 Then s3 = " moät" Else s3 = " moát"
      ElseIf n3 = 5 And n2 <> 0 Then
        s3 = " laêm"
      Else
        s3 = s09(n3)
      End If
      If i > Len(conso) Then
        s123 = s1 & s2 & s3
      Else
        s123 = s1 & s2 & s3 & lop3(lop)
      End If
    End If
    lop = lop + 1
    If lop > 3 Then lop = 1
    docso = docso & s123
    If i > Len(conso) Then Exit Do
  Loop
  If docso = "" Then DocSoVni = "khoâng" Else DocSoVni = dau & Trim(docso)
Else
  DocSoVni = conso
End If
End Function
'==================================
Function DocSoAbc(conso) As String
s09 = Array("", " mét", " hai", " ba", " bèn", " n¨m", " s¸u", " b¶y", " t¸m", " chÝn")
lop3 = Array("", " triÖu", " ngh×n", " tû", " triÖu", " ngh×n", "")
If Trim(conso) = "" Then
  DocSoAbc = ""
ElseIf IsNumeric(conso) = True Then
  If conso < 0 Then dau = "©m " Else dau = ""
  conso = Application.WorksheetFunction.Round(Abs(conso), 0)
  conso = " " & conso
  conso = Replace(conso, ",", "", 1)
  vt = InStr(1, conso, "E")
  If vt > 0 Then
    sonhan = Val(Mid(conso, vt + 1))
    conso = Trim(Mid(conso, 2, vt - 2))
    conso = conso & String(sonhan - Len(conso) + 1, "0")
  End If
  conso = Trim(conso)
  sochuso = Len(conso) Mod 9
  If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
  docso = ""
  i = 1
  lop = 1
  Do
    n1 = Mid(conso, i, 1)
    n2 = Mid(conso, i + 1, 1)
    n3 = Mid(conso, i + 2, 1)
    baso = Mid(conso, i, 3)
    i = i + 3
    If n1 & n2 & n3 = "000" Then
      If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " tû" Else s123 = ""
    Else
      If n1 = 0 Then
        If docso = "" Then s1 = "" Else s1 = " kh«ng tr¨m"
      Else
        s1 = s09(n1) & " tr¨m"
      End If
      If n2 = 0 Then
        If s1 = "" Or n3 = 0 Then
          s2 = ""
        Else
          s2 = " linh"
        End If
      Else
        If n2 = 1 Then s2 = " m­êi" Else s2 = s09(n2) & " m­¬i"
      End If
      If n3 = 1 Then
        If n2 = 1 Or n2 = 0 Then s3 = " mét" Else s3 = " mèt"
      ElseIf n3 = 5 And n2 <> 0 Then
        s3 = " l¨m"
      Else
        s3 = s09(n3)
      End If
      If i > Len(conso) Then
        s123 = s1 & s2 & s3
      Else
        s123 = s1 & s2 & s3 & lop3(lop)
      End If
    End If
    lop = lop + 1
    If lop > 3 Then lop = 1
    docso = docso & s123
    If i > Len(conso) Then Exit Do
  Loop
  If docso = "" Then DocSoAbc = "kh«ng" Else DocSoAbc = dau & Trim(docso)
Else
  DocSoAbc = conso
End If
End Function
'===============================
Function DocSoUni(conso) As String
s09 = Array("", " m" & ChrW(7897) & "t", " hai", " ba", " b"  & ChrW(7889) & "n", " n" & ChrW(259) & "m", " s" &  ChrW(225) & "u", " b" & ChrW(7843) & "y", " t" &  ChrW(225) & "m", " ch" & ChrW(237) & "n")
lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
'Stop
If Trim(conso) = "" Then
  DocSoUni = ""
ElseIf IsNumeric(conso) = True Then
  If conso < 0 Then dau = ChrW(226) & "m " Else dau = ""
  conso = Application.WorksheetFunction.Round(Abs(conso), 0)
  conso = " " & conso
  conso = Replace(conso, ",", "", 1)
  vt = InStr(1, conso, "E")
  If vt > 0 Then
    sonhan = Val(Mid(conso, vt + 1))
    conso = Trim(Mid(conso, 2, vt - 2))
    conso = conso & String(sonhan - Len(conso) + 1, "0")
  End If
  conso = Trim(conso)
  sochuso = Len(conso) Mod 9
  If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
  docso = ""
  i = 1
  lop = 1
  Do
    n1 = Mid(conso, i, 1)
    n2 = Mid(conso, i + 1, 1)
    n3 = Mid(conso, i + 2, 1)
    baso = Mid(conso, i, 3)
    i = i + 3
    If n1 & n2 & n3 = "000" Then
      If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
    Else
      If n1 = 0 Then
        If docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
      Else
        s1 = s09(n1) & " tr" & ChrW(259) & "m"
      End If
      If n2 = 0 Then
        If s1 = "" Or n3 = 0 Then
          s2 = ""
        Else
          s2 = " linh"
        End If
      Else
        If n2 = 1 Then s2 = " m" & ChrW(432) & ChrW(7901) &  "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) &  "i"
      End If
      If n3 = 1 Then
        If n2 = 1 Or n2 = 0 Then s3 = " m" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
      ElseIf n3 = 5 And n2 <> 0 Then
        s3 = " l" & ChrW(259) & "m"
      Else
        s3 = s09(n3)
      End If
      If i > Len(conso) Then
        s123 = s1 & s2 & s3
      Else
        s123 = s1 & s2 & s3 & lop3(lop)
      End If
    End If
    lop = lop + 1
    If lop > 3 Then lop = 1
    docso = docso & s123
    If i > Len(conso) Then Exit Do
  Loop
  If docso = "" Then DocSoUni = "kh" & ChrW(244) & "ng" Else DocSoUni = dau & Trim(docso)
Else
  DocSoUni = conso
End If
End Function
Cái này muốn phát triển lên thành đọc số tiền thì làm thế nào ạh... như kiểu hàm VND, USD ... giống addin đọc số tiền của Thày Nguyễn Duy Tuân...
 
Cái này muốn phát triển lên thành đọc số tiền thì làm thế nào ạh... như kiểu hàm VND, USD ... giống addin đọc số tiền của Thày Nguyễn Duy Tuân...
Ngay ở bài đó đã có hướng dẫn sử dung rồi
Đó là
Đây là hàm đổi số ra chữ cho 3 bảng mã :
Unicode: hàm DocSoUni
Vni Window: hàm DocSoVni
TCVN3 ABC: hàm DocSoAbc
Bạn Insert/Module rồi copy code trên vào rồi dùng 1 trong 3 cách đọc trên.
 
Ngay ở bài đó đã có hướng dẫn sử dung rồi
Đó là
Đây là hàm đổi số ra chữ cho 3 bảng mã :
Unicode: hàm DocSoUni
Vni Window: hàm DocSoVni
TCVN3 ABC: hàm DocSoAbc
Bạn Insert/Module rồi copy code trên vào rồi dùng 1 trong 3 cách đọc trên.
Cảm ơn a... nhưng ý mình ở đây là đọc ra số tiền.. vd: 12,500 => mười hai nghìn năm trăm đồng...
Còn code trên mới chỉ là đọc ra thành chữ thôi, chưa có tiền tệ...
 
Cảm ơn a... nhưng ý mình ở đây là đọc ra số tiền.. vd: 12,500 => mười hai nghìn năm trăm đồng...
Còn code trên mới chỉ là đọc ra thành chữ thôi, chưa có tiền tệ...

Trời má ơi!
Có mỗi chữ "Đồng" thôi, bạn tự thêm vào hổng lẽ cũng không làm được sao?
 
Cảm ơn a... nhưng ý mình ở đây là đọc ra số tiền.. vd: 12,500 => mười hai nghìn năm trăm đồng...
Còn code trên mới chỉ là đọc ra thành chữ thôi, chưa có tiền tệ...
Mình chưa test thử code trên, có phải bạn thấy code trên đọc đúng số tiền ra chữ rồi ah?
Nếu muốn thêm tiền tệ vào thì
=DocSoUni(A1)&" đồng"
 
Mình chưa test thử code trên, có phải bạn thấy code trên đọc đúng số tiền ra chữ rồi ah?
Nếu muốn thêm tiền tệ vào thì
=DocSoUni(A1)&" đồng"
Cảm ơn bạn nhiều, mình đã làm thế này rồi... nhưng ở đây là muốn một code tổng hợp hơn
Như đọc VND,USD... rồi còn đọc các số thập phân nữa.
Nói chung là muốn xin cái code như kiểu addin acchelper, mã nguồn jo cũng mở hết rồi, nhưng căn bản ko biết j về lập trình nên ko biết view code của các addin đó như thế nào
 
Trời má ơi!
Có mỗi chữ "Đồng" thôi, bạn tự thêm vào hổng lẽ cũng không làm được sao?
Dạ, e thêm thì thêm được nhưng mà e muốn xin code đọc số tiền bằng chữ ý ạh, để e nhúng trực tiếp vào VBA, khỏi cần addin nữa
 
oai... có lẽ các cao thủ ko hiểu ý em do em diễn đạt hơi kém, hjk
Ý em ở đây là e muốn xin code ĐỌC SỐ TIỀN BẰNG CHỮ, còn code copy của thày Phạm Duy Long là mới chỉ đọc ra số thôi, còn đơn vị tiền tệ nữa (mà ko phải thêm thủ công chữ "đồng" hoặc "đôla"... vào)
 
Cảm ơn bạn nhiều, mình đã làm thế này rồi... nhưng ở đây là muốn một code tổng hợp hơn
Như đọc VND,USD... rồi còn đọc các số thập phân nữa.
Nói chung là muốn xin cái code như kiểu addin acchelper, mã nguồn jo cũng mở hết rồi, nhưng căn bản ko biết j về lập trình nên ko biết view code của các addin đó như thế nào
Mình cho bạn thấy code của add in của a Tuân đây

Option Explicit
'Author : Nguyen Duy Tuan
'E.Mail : tuanktcdcn@yahoo.com
'Tel : 0904.210.337
'Website: www.bluesofts.net


#If VBA7 Then
'Declare PtrSafe Sub...
Declare PtrSafe Function VNDW Lib "AccHelper.xll" Alias "VND" (ByVal Amount As Currency, _
Optional ByVal OutputType As Integer = 3, _
Optional ByVal Unit1 As Variant = "", _
Optional ByVal Unit2 As Variant = "", _
Optional ByVal MUnit2 As Long = 1, _
Optional ByVal HasGroupingSymbol As Boolean = False) As Variant
'OutputType = 1 => TCVN3(ABC)
'OutputType = 2 => VNI
'OutputType = 3 => UNICODE (Ngam dinh)


Declare PtrSafe Function USDW Lib "AccHelper.xll" Alias "USD" (ByVal Amount As Currency, _
Optional ByVal Unit1 As Variant = vbNullString, _
Optional ByVal Unit2 As Variant = vbNullString, _
Optional ByVal MUnit2 As Long = 1, _
Optional ByVal HasGroupingSymbol As Boolean = False) As Variant


Declare PtrSafe Function Num2StrW Lib "AccHelper.xll" Alias "Num2Str" (ByVal Amount As Currency, _
Optional ByVal LangType As Integer = 2, _
Optional ByVal Unit1 As Variant = vbNullString, _
Optional ByVal Unit2 As Variant = vbNullString, _
Optional ByVal MUnit2 As Long = 1, _
Optional ByVal HasGroupingSymbol As Boolean = False) As Variant


'LangType = 1 => Viet Nam
'LangType = 2 => English


Declare PtrSafe Function ToUNC Lib "AccHelper.xll" Alias "UNC" (ByVal Text As Variant, _
Optional ByVal InputType As Integer = 1) As Variant
'InputType = 1 TCVN3>>UNICODE (ngam dinh)
'InputType = 2 VNI>>UNICODE


#Else


Declare Function VNDW Lib "AccHelper.xll" Alias "VND" (ByVal Amount As Currency, _
Optional ByVal OutputType As Integer = 3, _
Optional ByVal Unit1 As Variant = vbNullString, _
Optional ByVal Unit2 As Variant = vbNullString, _
Optional ByVal MUnit2 As Long = 1, _
Optional ByVal HasGroupingSymbol As Boolean = False) As Variant
'OutputType = 1 => TCVN3(ABC)
'OutputType = 2 => VNI
'OutputType = 3 => UNICODE (Ngam dinh)


Declare Function USDW Lib "AccHelper.xll" Alias "USD" (ByVal Amount As Currency, _
Optional ByVal Unit1 As Variant = vbNullString, _
Optional ByVal Unit2 As Variant = vbNullString, _
Optional ByVal MUnit2 As Long = 1, _
Optional ByVal HasGroupingSymbol As Boolean = False) As Variant


Declare Function Num2StrW Lib "AccHelper.xll" Alias "Num2Str" (ByVal Amount As Currency, _
Optional ByVal LangType As Integer = 2, _
Optional ByVal Unit1 As Variant = vbNullString, _
Optional ByVal Unit2 As Variant = vbNullString, _
Optional ByVal MUnit2 As Long = 1, _
Optional ByVal HasGroupingSymbol As Boolean = False) As Variant


'LangType = 1 => Viet Nam
'LangType = 2 => English


Declare Function ToUNC Lib "AccHelper.xll" Alias "UNC" (ByVal Text As Variant, _
Optional ByVal InputType As Integer = 1) As Variant
'InputType = 1 TCVN3>>UNICODE (ngam dinh)
'InputType = 2 VNI>>UNICODE


#End If


Sub Test()
Dim s As String
s = VNDW(102300, 1, "U1", "U2", 1, True)
Debug.Print s
End Sub
 
Function VND(baonhieu)
'Tien Viet tieng Viet Font Unicode
Dim KetQua, SoTien, Nhom, Chu, Dich, S1, S2, S3 As String
Dim I, J, ViTri As Byte, S As Double
Dim Hang, Doc, Dem
If Trim(baonhieu) = "" Then
VND = ""
Exit Function
ElseIf baonhieu = 0 Then
VND = "kh" & ChrW(244) & "ng"
Exit Function
ElseIf IsDate(baonhieu) Then
ngay = Day(baonhieu)
Thang = Month(baonhieu)
Nam = Year(baonhieu)
VND = "ng" & ChrW(224) & "y " & ngay & " th" & ChrW(225) & "ng " & Thang & " n" & ChrW(462) & "m " & Nam
Exit Function
ElseIf IsNumeric(baonhieu) = True Then
'---------------------------------------------------------------------------------------------------------------------------------
'If baonhieu = 0 Then
'KetQua = "Kh" & ChrW$(244) & "ng " & ChrW$(273) & ChrW$(7891) & "ng"
'Else
'---------------------------------------------------------------------------------------------------------------------------------
If Abs(baonhieu) >= 1E+15 Then
KetQua = "S" & ChrW$(7889) & " qu" & ChrW$(225) & " l" & ChrW$(7899) & "n - H" & ChrW$(224) & "m " & ChrW$(273) & ChrW$(7893) & "i s" & ChrW$(7889) & " ra ch" & ChrW$(7919) & " Vi" & ChrW$(7879) & "t Nam; font ch" & ChrW$(7919) & " Tahoma - Copyright by VoTuanKiet of AMG (0938 73 73 93)"
Else
If baonhieu < 0 Then
KetQua = ChrW$(194) & "m" & Space(1)
Else
KetQua = Space(0)
End If
SoTien = Format(Abs(baonhieu), "##############0.00")
SoTien = Right(Space(15) & SoTien, 18)
Hang = Array("None", "tr" & ChrW$(259) & "m", "m" & ChrW$(432) & ChrW$(417) & "i", "g" & ChrW$(236) & " " & ChrW$(273) & "ã")
Doc = Array("None", "ng" & ChrW$(224) & "n t" & ChrW$(7927), "t" & ChrW$(7927), "tri" & ChrW$(7879) & "u", "ng" & ChrW$(224) & "n", ChrW$(273) & ChrW$(7891) & "ng", "")
Dem = Array("None", "m" & ChrW$(7897) & "t", "hai", "ba", "b" & ChrW$(7889) & "n", "n" & ChrW$(259) & "m", "s" & ChrW$(225) & "u", "b" & ChrW$(7849) & "y", "t" & ChrW$(225) & "m", "ch" & ChrW$(237) & "n")
For I = 1 To 6
Nhom = Mid(SoTien, I * 3 - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If I = 5 Then
Chu = ChrW$(273) & ChrW$(7891) & "ng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = "ch" & ChrW$(7861) & "n"
Case Else
S1 = Left(Nhom, 1)
S2 = Mid(Nhom, 2, 1)
S3 = Right(Nhom, 1)
Chu = Space(0)
Hang(3) = Doc(I)
For J = 1 To 3
Dich = Space(0)
S = Val(Mid(Nhom, J, 1))
If S > 0 Then
Dich = Dem(S) & Space(1) & Hang(J) & Space(1)
End If
Select Case J
Case 2 And S = 1
Dich = "m" & ChrW$(432) & ChrW$(7901) & "i" & Space(1)
Case 3 And S = 0 And Nhom <> Space(2) & "0"
Dich = Hang(J) & Space(1)
Case 3 And S = 5 And S2 <> Space(1) And S2 <> "0"
Dich = "l" & Mid(Dich, 2)
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 4) Then
Dich = "l" & ChrW$(7867) & Space(1)
End If
End Select
Chu = Chu & Dich
Next J
End Select
ViTri = InStr(1, Chu, "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7897) & "t", 1)
If ViTri > 0 Then Mid(Chu, ViTri, 9) = "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7889) & "t"
KetQua = KetQua & Chu
End If
Next I
End If
End If
VND = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
Đây là code đọc số tiền bằng chữ của Hoàng Tử Cadafi, giờ e muốn thay vì đọc "đồng" thì đọc là "đô la Mỹ và ... cent" thì thay thế ở vị trí nào ạh ???
P/S: nhìn font của code thì choáng váng...ko biết thay thế ở đâu cho hợp lý +-+-+-+
 
ai gặp lỗi này rồi xin chỉ mình với, ở công ty có sẵn 1 file đọc số tiền như thế này rồi, file mở lên không hiển thị đc đọc số tiền ra tiếng anh, trong khi đọc tiếng việt thì vẫn bình thường, qua sheet mới cũng không đc, nhưng tạo 1 file excel mới thì đọc usd bình thường, copy từ file mới này qua file cũ thì nó hiển thị, copy và dán vào nơi cần đọc và sửa lại ô cần đọc thì nó không hiện ra format dạng như "=usd(A1)" mà lại là "='userfuntion.xla'!usd(A1)" . Vậy tình trạng này là lỗi gì và có cách nào khắc phục không ???
 
Web KT
Back
Top Bottom