Sửa lỗi font trong hàm chuyển số ra chữ

[ltthanhsg2001]

Tôi down load về một đoạn mã đổi số ra chữ của một thành viên nào đó không nhớ lắm. Nay cài vào máy theo hướng dẫn thì không đọc được font sau khi chạy. Bác nào giúp tôi với (tôi dùng font Times new romance mặc định, gõ bằng unicode trong unikey 4RC).
1/. Mở 1 file XLS rồi vào menu TOOL/Macro/VBA rồi Insert/Module.
2/. Copy code dưới đây dán vào.
3/. Save lại vào trong thư mục C:\Program Files\Microsoft Office\OFFICE11\XLSTART.

Public Function doctien(FirstArg As Object)
Dim chu, aaa, bbb, so3
chu = Abs(FirstArg.Value)
chu = Format(chu, "0.00")
If chu > 10 ^ 99 Then
doctien = FirstArg.Value
Exit Function
End If
aaa = Left(chu, Len(chu) - 3)
bbb = Right(chu, 2) so3 = dich(CStr(aaa)) & "đồng" & IIf(Val(bbb) 0, " " & dich(CStr(bbb)) & "xu.", ".") so3 = Replace(so3, ", tỷ", " tỷ") '* Làm cho đẹp so3 = Replace(so3, ", đồng", " đồng") so3 = Chr(Asc(Left(so3, 1)) - 32) + Mid(so3, 2) ' Viết hoa chữ đầu If FirstArg.Value < 0 Then so3 = "(Âm) " & so3 doctien = so3 End Function Function dich(yy As String) Dim mm, docso, kkdai kkdai = Len(yy) If Len(yy) < 10 Then docso = "" For mm = 1 To Len(yy) docso = docso & Mid(yy, mm, 1) & Chr(65 + Len(yy) - mm) Next Else docso = dich(Left(yy, kkdai - 9)) & "tỷ, " & dich(Right(yy, 9)) dich = docso Exit Function End If docso = Replace(docso, "A", "donvi") docso = Replace(docso, "B", "mươi ") docso = Replace(docso, "C", "trăm ") docso = Replace(docso, "D", "ngàn, ") docso = Replace(docso, "E", "mươi ") docso = Replace(docso, "F", "trăm ") docso = Replace(docso, "G", "triệu, ") docso = Replace(docso, "H", "mươi ") docso = Replace(docso, "I", "trăm ") docso = Replace(docso, "0", "không ") docso = Replace(docso, "1", "một ") docso = Replace(docso, "2", "hai ") docso = Replace(docso, "3", "ba ") docso = Replace(docso, "4", "bốn ") docso = Replace(docso, "5", "năm ") docso = Replace(docso, "6", "sáu ") docso = Replace(docso, "7", "bảy ") docso = Replace(docso, "8", "tám ") docso = Replace(docso, "9", "chín ") docso = Replace(docso, "không mươi", "lẻ") '* Bước điều chỉnh docso = Replace(docso, "mươi không", "mươi") docso = Replace(docso, "không trăm lẻ không ", "không ") docso = Replace(docso, "trăm lẻ không", "trăm") docso = Replace(docso, "mươi năm", "mười lăm") docso = Replace(docso, "một mươi", "mười") docso = Replace(docso, "mươi một", "mươi mốt") docso = Replace(docso, " không donvi", " donvi") docso = Replace(docso, "không ngàn, donvi", "donvi") docso = Replace(docso, "không triệu, donvi", "donvi") docso = Replace(docso, "donvi", "") dich = docso End Function

Mong sớm có hồi âm, xin cảm ơn./.
Thôi bạn vào mục AddIns tìm lại cái hàm khác. Cố gắng đọc để trả lời còn mệt hơn chỉ bạn kiếm.
Dùng đỡ cái này thế

Function VNUD(baonhieu)
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 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) & " .Vntime - Copyright by MaiKa of AQN (0953-357-988)"
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$(272), "t" & ChrW$(272), "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
VNUD = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function

 

[BNTT]

Về vấn đề chuyển số thành chữ, bạn tìm trong diễn đàn đi, nhiều lắm.

Ví dụ ở đây: http://www.giaiphapexcel.com/forum/showthread.php?t=65

Cách tìm kiếm: Bạn nhấn cái mục Tìm kiếm, rồi gõ "chuyển số thành chữ" vào, nhấn Enter... bạn sẽ thấy rất nhiều bài đã viết về vấn đề này.