Hàm đọc số dùng mã Unicode trong Access

[uronmapu]

Đã áp dụng bài của noname thành công bằng lệnh gọi hàm =DocVND([TinhTong])

Nhưng lỗi hiển thị chữ "sáu" ko chính xác

Không biết ai bị lỗi này ko

Khắc phục: cho font về Arial là được

[quanghoasla]

do cài đặt font của bạn thôi. cái này mình dùng lâu lắm rồi. thấy chính sác mà.

[Nguyendinhthanh]

do cài đặt font của bạn thôi. cái này mình dùng lâu lắm rồi. thấy chính sác mà.

èo, chính xác chứ không phải là chính sác nhé!: 014:

[Xuân Thanh]

Một hàm đọc số cực ngắn cho font Unicode

Mã PHP:

Public Function DocSo(Number As Double)
    Dim MyArray
    Dim Str As String
    If Number >= 1E+18 Then DocSo = "#NUM!": Exit Function
    Str = Format(Fix(Abs(Number)), "000000000000000000")
    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 ")
    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) <> Number, MyArray(31), "") & IIf(Fix(Number) <> Number, IIf(Abs(Number - Fix(Number)) < 0.1, "", MyArray(Left(Right(Format(Abs(Number), "#.00"), 2), 1)) & MyArray(17)) & MyArray(Right(Format(Number, "#.00"), 1)) & MyArray(32), "")
    DocSo = Replace(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))), MyArray(30) & MyArray(31), Split(MyArray(30), " ")(0) & " " & MyArray(31))
    If Number < 0 Then DocSo = MyArray(29) & DocSo
    DocSo = UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & "."
End Function 


[uronmapu]

Em đã thử code Xuân Thanh
Chuẩn luôn bác, e đang tìm
Cảm ơn bác nhé

[changkhoonline77]

Mình làm theo cách của Noname ok
nhưng mình muốn kết quả hiện trên textbox thì làm sao vậy? mình thử đổi bằng textbox nhưng hỏng ra

không coi kỹ hướng dẫn nên làm không ra. coi kỹ thì ra chỉ cần tạo 1 text box rồi đặt hàm =docVND([sotien]) với sotien là text box chứa số cần đổi ra chữ. vậy là xong

[camau]

mình lần mò áp dụng bài của ronmapu vào phần mềm của mình. nhưng mỗi lần khởi động open thì nó bị lỗi (nó vào thẳng màn hình VB mà không theo đường dẫn để vào form. trong mã lệnh VB nó báo lỗi màu vàng ở chổ này nè
(If so = Null Then)
cả nhà xem và sữa xem sao. mình mới làm quen với câu lệnh VB nên dốt lăm. cả nhà thông cảm
sẵn đây cho mình hỏi. phần mềm của mình thiết kế dùng font Times New Roman nhưng mã lệnh không phù hợp, không biết có thể chuyển qua được không vậy?

[changkhoonline77]

Em đã thử code Xuân Thanh
Chuẩn luôn bác, e đang tìm
Cảm ơn bác nhé

bạn hướng dẫn sử dụng hàm đọc số của Xuân Thanh đi bạn

[Xuân Thanh]

bạn hướng dẫn sử dụng hàm đọc số của Xuân Thanh đi bạn

1/ Chép hàm trên vào một modul
2/ Trong form hoặc report tạo một texbox có Control Source là =DocSo([txtSoTien]), trong đó txtSoTien là textbox chứa Số Tiền cần đọc ra chữ
Thân

[wwwphuong]

Xin cảm ơn bạn Noname về đoạn code trên.
Mình xin biên tập lại thành 1 hàm đặt trong module và không cần formTam nữa:

Public Function DocUNI(Sodoc As String) As String
If Len(Sodoc) > 12 Then
DocVND = "So qua lon qua hang tram ty. Hay xem lai!"
Exit Function
End If
Sodoc = Round(Sodoc, 0)
Dim fg0, fg1 As Boolean
Dim Cht, So, ch, tp As String
Dim i As Byte
Dim dv() As String
Dim chs() As String
chs = Split("không ;m" & ChrW$(&H1ED9) & "t ;hai ;ba ;b" & ChrW$(&H1ED1) & "n ;n" & ChrW$(&H103) & "m ;sáu ;b" & ChrW$(&H1EA3) & "y ;tám ;chín ;m" & ChrW$(&H1ED1) & "t ;l" & ChrW$(&H1EBB) & " ;l" & ChrW$(&H103) & "m ;m" & ChrW$(&H1B0) & ChrW$(&H1A1) & "i ;m" & ChrW$(&H1B0) & ChrW$(&H1EDD) & "i ;tr" & ChrW$(&H103) & "m ", ";")
dv = Split(" ;nghìn ;tri" & ChrW$(&H1EC7) & "u ;t" & ChrW$(&H1EF7) & " ", ";")
'THEM CHU DONG.
'dv = Split(ChrW$(&H111) & ChrW$(&H1ED3) & "ng. nghìn tri" & ChrW$(&H1EC7) & "u t" & ChrW$(&H1EF7) & " ", " ")

Do While Sodoc <> ""
Cht = ""
If Len(Sodoc) <> 0 Then
If (Len(Sodoc) >= 3) Then
So = Right(Sodoc, 3)
Else
So = Right(Sodoc, Len(Sodoc))
End If
Sodoc = Left(Sodoc, Len(Sodoc) - Len(So))
If Left(So, 1) = "0" And Mid(So, 2, 1) = "0" And Right(So, 1) = "0" Then
ch = ch
Else
If Len(So) = 3 Then
If Left(So, 1) <> " " Then Cht = chs(Left(So, 1)) + chs(15)
So = Right(So, 2)
End If
If Len(So) = 2 Then
If Left(So, 1) = "0" Then
If Right(So, 1) <> "0" Then Cht = Cht + chs(11)
fg0 = True
Else
If Left(So, 1) = "1" Then
Cht = Cht + chs(14)
Else
Cht = Cht + chs(Left(So, 1)) + chs(13)
fg1 = True
End If
End If
So = Right(So, 1)
End If
If Right(So, 1) <> 0 Then
If Left(So, 1) = "5" And Not fg0 Then
If Len(tp) = 1 Then
Cht = Cht + chs(4)
Else
Cht = Cht + chs(12)
End If
Else
If Left(So, 1) = 1 And Not (Not fg1 Or fg0) And Cht <> "" Then
Cht = Cht + chs(10)
Else
Cht = Cht + chs(Left(So, 1))
End If
End If
End If
ch = Cht & dv(i) & ch
End If
i = i + 1
End If
Loop
If Right(Trim(ch), 1) <> "." Then
ch = ch + dv(0)
End If
DocUNI = ch
End Function