Sửa Macro dọc số tiền bằng chữ

[duynhat84]

Nhờ các Anh, Chi sửa gùm Macro dọc số tiền bằng chữ sao cho nó viết chữ hoa đầu câu
Em cảm ơn nhiều
Em gửi file kèm theo

 

[viehoai]

Nhờ các Anh, Chi sửa gùm Macro dọc số tiền bằng chữ sao cho nó viết chữ hoa đầu câu
Em cảm ơn nhiều
Em gửi file kèm theo

Bạn tham khảo hàm của anh Huuthang_Bd áp dụng cho cả 3 font chữ

Function DocSo(Number, Font, Optional USD As Boolean = False) As String
Dim MyArray, Tam
Dim Str As String, Str1 As String, Chan As String
Str = Format(Fix(Abs(Number)), "000000000000000000")
Select Case Font
    Case 1
    If USD Then
        MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ", ChrW(272) & "ô la M" & ChrW(7929) & " ", "và ", "cent ")
    Else
        MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ", ChrW(273) & ChrW(7891) & "ng ", "và ", "xu ")
    End If
    Chan = " ch" & ChrW(7861) & "n "
Case 2
    If USD Then
        MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ", "Ñoâ la Myõ ", "vaø ", "cent ")
    Else
        MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ", "ñoàng ", "vaø ", "xu ")
    End If
    Chan = " chaün "
Case 3
    If USD Then
        MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m­¬i ", "kh«ng m­¬i kh«ng ", "kh«ng m­¬i", "lÎ", "m­¬i kh«ng", "m­¬i", "m­¬i n¨m", "m­¬i l¨m", "mét m­¬i", "m­êi", "m­¬i mét", "m­¬i mèt", "¢m ", "§« la Mü ", "vµ ", "cent ")
    Else
        MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m­¬i ", "kh«ng m­¬i kh«ng ", "kh«ng m­¬i", "lÎ", "m­¬i kh«ng", "m­¬i", "m­¬i n¨m", "m­¬i l¨m", "mét m­¬i", "m­êi", "m­¬i mét", "m­¬i mèt", "¢m ", "®ång ", "vµ ", "xu ")
    End If
    Chan = " ch½n "
End Select
If Number = 0 Then
    DocSo = MyArray(0)
Else
    DocSo = ""
End If
For i = 1 To Len(Str)
    If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
        DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
    ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
        DocSo = DocSo & MyArray(12)
    End If
Next
DocSo = IIf(Number = 0, MyArray(0) & MyArray(30), "") & IIf(Fix(Number) <> 0, DocSo & MyArray(30), "") & IIf(Fix(Number) <> 0 And Fix(Number) <> Round(Number, 2), MyArray(31), "") & IIf(Fix(Number) <> Round(Number, 2), IIf(Round(Abs(Number - Fix(Number)), 2) < 0.1, "", MyArray(Left(Right(Format(Abs(Number), "#.00"), 2), 1)) & MyArray(17)) & MyArray(Right(Format(Number, "#.00"), 1)) & MyArray(32), "")
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)), ", " & MyArray(30), " " & MyArray(30)))
If Number < 0 Then
    DocSo = MyArray(29) & DocSo
End If
    If Number / 1000 - Int(Number / 1000) > 0 Then
      DocSo = UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & "."
    Else
      DocSo = UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & Chan & "."
    End If
End Function

 

[luythep]

Nếu muốn chữ đầu viết hoa thì cách đơn giản là bạn nên sử dụng phần mềm đổi chữ ra số, sau đó tại dòng muốn đọc thành chữ bạn gõ lệnh như sau: =VND(...) & " đồng chẳn " rồi Enter là được. Ở (...) bạn nhấp chọn vào ô có chứa số tiền bằng số nhé. Chúc thành công!