Tùy chọn
Hàm đọc số dùng mã Unicode trong Access
- Hàm đọc số dùng mã Unicode trong Access
-
Hàm đọc số dùng mã Unicode trong Access
Noname > 26-08-10, 12:54 AM
Do môi trường VBA chưa hỗ trợ Unicode đầy đủ nên việc thiết lập hàm đọc số tiếng Việt với mã (font) Unicode trong Access cũng như Excel có khó khăn. Bài viết này giới thiệu một cách thiết lập hàm đọc số dùng font Unicode trong Access (bạn cũng có thể áp dụng trong Excel, VB...).
Các bước thực hiện như sau:
1. Mở CSDL Access.
2. Tạo một form đặt tên là FormTam, trên FormTam tạo hai label:
LabSo, nhập chuỗi: “không một hai ba bốn năm sáu bảy tám chín mốt lẻ lăm mươi mười trăm ”, cuối chuỗi có một khoảng trắng.
LabDonvi, nhập chuỗi: “đồng. nghìn triệu tỷ”, cuối chuỗi cũng có khoảng trắng.
3. Trong Module, nhấn New để tạo mới một module với tên mặc định là Module1. Sau đó nhấn Design để vào cửa sổ soạn code và nhập đoạn mã sau:
Khai báo 2 biến toàn cục là 2 mảng chứa chuỗi ký tự số và chuỗi đơn vị được lấy từ LabSo và LabDonvi thông qua thủ tục Docchu và Docdonvi.
'''''Mã:Public Solay(0 To 15) As String
Public Donvilay(0 To 4) As String
Private Sub Docchu() 'Lấy chuỗi chữ số từ LabSo đặt vào mảng Solay
Dim tp, Stp, ii
ii = 0: tp = Form_FormTam.LabSo.Caption
Stp = InStr(tp, “ “)
Do While Stp <> 0
Solay(ii) = Left(tp, Stp)
tp = Right(tp, Len(tp) - Stp)
1Stp = InStr(tp, “ “)
ii = ii + 1
Loop
End Sub
Mã:Private Sub Docdonvi() 'Lấy chuỗi đơn vị từ LabDonvi đặt vào mảng Donvilay
Dim tp, Stp, ii
ii = 0: tp = Form_FormTam.LabDonvi.Caption
Stp = InStr(tp, “ “)
Do While Stp <> 0
Donvilay(ii) = Left(tp, Stp)
tp = Right(tp, Len(tp) - Stp)
Stp = InStr(tp, “ “)
ii = ii + 1
Loop
End Sub
'Tạo hàm đọc số:
Mã:Public Function DocVND(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 Cht As String
Dim fg0 As Boolean
Dim fg1 As Boolean
Dim So As String
Dim ch As String
Dim tp As String
Dim i As Byte
Dim dv
Dim chs
Docchu Gọi hàm đọc chữ số
chs = Solay
Docdonvi Gọi hàm đọc đơn vị
dv = Donvilay
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)
End If
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)
End If
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
DocVND=UCase(Left(ch, 1))&Mid(ch,2)
End Function
Ở đây tôi không phân tích hàm đọc số bởi TGVT đã có bài về vấn đề này (TGVT A 3/2001, t.76; 7/2001, t.88).
4. Sử dụng hàm DocVND
Tạo một Textbox có tên là Text1, nhấn phải lên Text1 chọn Build Event, trong Choose Builder chọn Code Builder và nhấn OK. Cửa sổ Microsoft VB hiện ra, nhập đoạn code sau:
Mã:Private Sub Text1_BeforeUpdate(Cancel As Integer)
Ketqua.Caption = DocVND(Text1.Text)
End Sub
Mở form, nhập vào các con số và gõ Enter, bạn sẽ có kết quả như hình. Mã nguồn chương trình có thể tải về tại website của TGVT – PCW VN.
DownLoad Demo
-------------------------------------
Trên đây là bài mình đăng nguyên văn từ báo PC-Word. Mình cũng xin góp ý với chương trình này : Thay vì làm bước:
2. Tạo một form đặt tên là FormTam, trên FormTam tạo hai label:
LabSo, nhập chuỗi: “không một hai ba bốn năm sáu bảy tám chín mốt lẻ lăm mươi mười trăm ”, cuối chuỗi có một khoảng trắng.
LabDonvi, nhập chuỗi: “đồng. nghìn triệu tỷ”, cuối chuỗi cũng có khoảng trắng.
Ta có thể thay bằng cách tạo 1 table và lưu các giá trị trên vào. Sau đó gọi ra bằng 1 biến chuỗi hoặc hàm Dlookup tùy ý. Như vậy, ta có thể gọi hàm đọc số bất cứ đâu mà không cần tạo formTam -
RE: Hàm đọc số dùng mã Unicode trong Access
hmhieu > 18-12-10, 02:50 PM
...........
2. Tạo một form đặt tên là FormTam, trên FormTam tạo hai label:
LabSo, nhập chuỗi: “không một hai ba bốn năm sáu bảy tám chín mốt lẻ lăm mươi mười trăm ”, cuối chuỗi có một khoảng trắng.
LabDonvi, nhập chuỗi: “đồng. nghìn triệu tỷ”, cuối chuỗi cũng có khoảng trắng.
Ta có thể thay bằng cách tạo 1 table và lưu các giá trị trên vào. Sau đó gọi ra bằng 1 biến chuỗi hoặc hàm Dlookup tùy ý. Như vậy, ta có thể gọi hàm đọc số bất cứ đâu mà không cần tạo formTam
[/quote]
Bác có thể tải Demo theo cách làm này được không? mình thì cần lắm nhưng gà quá, khong biết làm, hic hic. -
RE: Hàm đọc số dùng mã Unicode trong Access
haquocquan > 18-12-10, 03:30 PM
Có một cách này, thực ra hơi rườm rà, nhưng bạn có thể áp dụng tạm, sau đó tính tiếp:
Bạn tạo 2 module:
Tạo module 1: copy đoạn mã convert TCVN3 to Unicode sau vào:
Mã:Function ToUnicode(txtString As String, Optional isReversed As Boolean = False, Optional isISO As Boolean = False) As String
' This function will do the conversion of text string into unicode
Dim iStr As String, repTxt As String, mText As String
Dim i As Long, j As Long
Dim iUnicode As Variant ' array to keep unicode char set
Dim iTCVN As Variant ' array to keep TCVN char set
Dim iProcList() As String ' array to keep what to convert
'parse the parameter into this local variable
iStr = txtString
mText = txtString
iUnicode = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, _
7845, 7847, 7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 234, 7871, 7873, 7875, _
7877, 7879, 237, 236, 7881, 297, 7883, 243, 242, 7887, 245, 7885, 244, 7889, 7891, _
7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 250, 249, 7911, 361, 7909, _
432, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, 7925, 273, 193, 192, 195, _
258, 194, 212, 416, 431, 272)
iTCVN = Array(184, 181, 182, 183, 185, 168, 190, 187, 188, 189, 198, 169, 202, 199, 200, _
201, 203, 208, 204, 206, 207, 209, 170, 213, 210, 211, 212, 214, 221, 215, 216, 220, _
222, 227, 223, 225, 226, 228, 171, 232, 229, 230, 231, 233, 172, 237, 234, 235, 236, _
238, 243, 239, 241, 242, 244, 173, 248, 245, 246, 247, 249, 253, 250, 251, 252, 254, _
174, 193, 192, 195, 161, 162, 164, 165, 166, 167)
' Reenlarge the array
ReDim iProcList(1, 133)
' process the vowel only and covert to asc code
For i = 1 To Len(mText)
repTxt = Mid(mText, i, 1)
If AscW(repTxt) > 122 Then
iStr = Replace(iStr, repTxt, "[" & AscW(repTxt) & "]")
mText = Replace(mText, repTxt, " ")
' write the processed list
iProcList(1, j) = "[" & AscW(repTxt) & "]"
If isISO Then
iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
Else
If isReversed Then
iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
Else
iProcList(0, j) = GetElementNo(AscW(repTxt), iTCVN)
End If
End If
j = j + 1
End If
Next
If j = 0 Then
ToUnicode = txtString
Exit Function
End If
ReDim Preserve iProcList(1, j - 1)
' now convert to unicode
For i = 0 To UBound(iProcList, 2)
If isReversed Then
iStr = Replace(iStr, iProcList(1, i), ChrW(iTCVN(Val(iProcList(0, i)))))
Else
If isISO Then
iStr = Replace(iStr, iProcList(1, i), "&#" & iUnicode(Val(iProcList(0, i))) & ";")
Else
iStr = Replace(iStr, iProcList(1, i), ChrW(iUnicode(Val(iProcList(0, i)))))
End If
End If
Next
fExit:
ToUnicode = iStr
End Function
Private Function GetElementNo(iTxt As Long, iObj As Variant) As String
Dim i As Long
For i = 0 To UBound(iObj)
If iTxt = iObj(i) Then
GetElementNo = CStr(i)
Exit For
End If
Next
End Function
Module 2: copy đoạn mã đọc số thành chữ sau vào:
Mã:Public Function VND(D_sotien As Double) As String
Dim Ketqua, b, tien, Chudoc, Chuso, i, BACONSO, Chu, so1, So2, So3, j, Dich, s, Vitri
Dim LoaiTien As String
LoaiTien = "®ång"
If D_sotien = 0 Then
Ketqua = "Kh«ng " + LoaiTien
Else
If D_sotien < 0 Then
Ketqua = "Trõ "
Else
Ketqua = ""
End If
b = " "
tien = Format(Abs(D_sotien), "##0.00")
tien = Right(Space(12) + tien, 15)
Chudoc = ""
Chudoc = Chudoc + "tr¨m m¬i tû "
Chudoc = Chudoc + "tr¨m m¬i triÖu "
Chudoc = Chudoc + "tr¨m m¬i ngµn "
Chudoc = Chudoc + "tr¨m m¬i " + Mid(LoaiTien + Space(6), 1, 6)
Chudoc = Chudoc + "tr¨m m¬i ch½n "
Chuso = ""
Chuso = Chuso + "mét hai ba bèn n¨m "
Chuso = Chuso + "s¸u b¶y t¸m chÝn "
For i = 1 To 5
BACONSO = Mid(tien, i * 3 - 2, 3)
If BACONSO <> Space(3) Then
Select Case BACONSO
Case "000"
If i = 4 Then
Chu = Left(LoaiTien + " ", 5)
Else
Chu = ""
End If
Case ".00"
Chu = "ch½n "
Case Else
so1 = Left(BACONSO, 1)
So2 = Mid(BACONSO, 2, 1)
So3 = Right(BACONSO, 1)
Chu = ""
For j = 1 To 3
Dich = ""
s = Val(Mid(BACONSO, j, 1))
If s > 0 Then
Dich = Trim(Mid(Chuso, s * 5 - 4, 5)) + b + Trim(Mid(Chudoc, (i - 1) * 18 + j * 6 - 5, 6)) + b
End If
Select Case j
Case 2 And s = 1
Dich = "mêi "
Case 3 And s = 0 And BACONSO <> Space(2) + "0"
Dich = Trim(Mid(Chudoc, (i - 1) * 18 + j * 6 - 5, 6)) + " "
Case 3 And s = 5 And So2 <> " " And So2 <> "0"
Dich = "l" + Mid(Dich, 2)
Case 2 And s = 0 And So3 > "0" And (so1 > "0" Or (so1 = " " And i = 4))
'If (So1 >= "1" And So1 <= "9") Or (So1 = "0" And I = 4) Then
Dich = "lÎ "
'End If
End Select
Chu = Chu + Dich
Next j
End Select
Vitri = InStr(1, Chu, "m¬i mét", 1)
If Vitri > 0 Then
Mid(Chu, Vitri, 9) = "m¬i mèt"
End If
Ketqua = Ketqua + Chu
End If
Next i
End If
VND = ToUnicode(UCase(Left(Ketqua, 1)) + Mid(Ketqua, 2))
End Function
sau đó tại textbox bạn gọi:
Mã:VND(sotien)
Cách này hơi chuối. Nhưng chưa có đoạn code chuyển số thành chữ unicode thì dùng tạm cũng ổn -
RE: Hàm đọc số dùng mã Unicode trong Access
haquocquan > 19-02-11, 01:34 AM
Mới sưu tầm được đoạn mã đọc số thành chữ Unicode. Mời các bạn tham khảo:
Tạo một Module:
Mã:Option Compare Database
Function docso(baonhieu)
On Error GoTo thongbaoloi
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"
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$(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$(7843) & "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
docso = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
thongbaoloi:
kqtqua = "loi cong thuc"
End Function
Các bạn hãy dùng thử nhé. -
RE: Hàm đọc số dùng mã Unicode trong Access
vtdcomputer > 28-04-12, 12:12 PM
Cho hỏi: Còn cái textbox: cw thì gắn thế nào vậy anh. Mục đích là muốn tham khảo, rồi áp dụng vào REPORT...
Thanks -
RE: Hàm đọc số dùng mã Unicode trong Access
vtdcomputer > 28-04-12, 09:56 PM
Nhờ bạn HaQuocQuan hướng dẫn thêm cách gắn 2 đoạn đó để dịch số từ 1 textbox1 chẳng hạn nhen.
Cảm ơn rất nhiều -
RE: Hàm đọc số dùng mã Unicode trong Access
Xuân Thanh > 29-04-12, 03:43 PM
(28-04-12, 09:56 PM)vtdcomputer Đã viết: Nhờ bạn HaQuocQuan hướng dẫn thêm cách gắn 2 đoạn đó để dịch số từ 1 textbox1 chẳng hạn nhen.
Cảm ơn rất nhiều
1/ Tạo một modul mới, chép cái hàm ở #4 vào
2/ Trong form hoặc report tạo môt textbox, gắn Control Source của nó =docso(text1). Trong đó text1 là ô chứa giá trị số cần đọc
Thân -
RE: Hàm đọc số dùng mã Unicode trong Access
ngamyeuem > 14-08-12, 10:50 PM
Mình đã dùng thư và gặp lỗi. Ví dụ: 15 chương trình đọc là "mười năm" thay vì "Mười Lăm" hoặc 21100 đọc là "Hai một nghìn một trăm đồng." -
RE: Hàm đọc số dùng mã Unicode trong Access
Xuân Thanh > 15-08-12, 09:48 AM
-
RE: Hàm đọc số dùng mã Unicode trong Access
uronmapu > 01-09-12, 12:24 PM
Mình có áp dụng bài của noname vào bài mình
Nhưng có khác 1 chút đó là, cái ô nhập số của noname mình đã có sẵn (tức là bài của mình ko phải nhập số vào nữa)
Mình có 1 cột vơí các giá trị trong từng dòng, dòng cuối là dòng tính tổng (đã đặt lệnh cho tính)
Mình muốn đọc giá trị của dòng tính tổng đó ra chữ thì làm thế nào
Xin mọi người tư vấn
Cảm ơn
Tìm thấy rồi
http://www2.hcmuaf.edu.vn/contents.php?u...n&ids=2913
Nhưng bài này lại thiếu chữ đồng ở cuối