-
RE: Hàm đọc số dùng mã Unicode trong Access
uronmapu > 01-09-12, 02:15 PM
Đã á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 -
RE: Hàm đọc số dùng mã Unicode trong Access
quanghoasla > 02-09-12, 08:43 PM
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à. -
RE: Hàm đọc số dùng mã Unicode trong Access
Xuân Thanh > 08-09-12, 11:22 AM
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 -
RE: Hàm đọc số dùng mã Unicode trong Access
uronmapu > 08-09-12, 11:34 PM
Em đã thử code Xuân Thanh
Chuẩn luôn bác, e đang tìm
Cảm ơn bác nhé -
RE: Hàm đọc số dùng mã Unicode trong Access
changkhoonline77 > 21-09-12, 06:24 PM
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 -
RE: Hàm đọc số dùng mã Unicode trong Access
camau > 07-10-12, 03:38 PM
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? -
RE: Hàm đọc số dùng mã Unicode trong Access
Xuân Thanh > 07-12-12, 10:30 AM
-
RE: Hàm đọc số dùng mã Unicode trong Access
wwwphuong > 25-01-13, 11:58 AM
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