Đánh giá chủ đề:
  • 4 Votes - 3.5 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Hàm đọc số dùng mã Unicode trong Access
#1

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
Chữ ký của Noname 020
ღღღღღTài sản của Noname (View All Items) ღღღღღ
Reply
Những người đã cảm ơn haquocquan , vtdcomputer , tammuc , nhunguyet0103 , chumeodien , Che_Guevara
#2
...........


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.
Chữ ký của hmhieu Hãy chia sẻ kinh nghiệm cùng mình trên ThuThuatAccess nhé! Chúc vui vẻ rose
Reply
Những người đã cảm ơn
#3
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
Chữ ký của haquocquan Guest, you are welcome!
ღღღღღTài sản của haquocquan (View All Items) ღღღღღ
Reply
Những người đã cảm ơn Noname , hmhieu
#4
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é.
Chữ ký của haquocquan Guest, you are welcome!
ღღღღღTài sản của haquocquan (View All Items) ღღღღღ
Reply
Những người đã cảm ơn Noname , lacbuidoi , TruongVanTruong
#5
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
Chữ ký của vtdcomputer Xin chào, mình là vtdcomputer, Tham gia http://thuthuataccess.com/forum từ ngày 14-05 -11.
Reply
Những người đã cảm ơn
#6
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
Chữ ký của vtdcomputer Xin chào, mình là vtdcomputer, Tham gia http://thuthuataccess.com/forum từ ngày 14-05 -11.
Reply
Những người đã cảm ơn
#7
(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
Chữ ký của Xuân Thanh Trăm năm trước thì ta chưa gặp
Trăm năm sau biết gặp được không?
Cuộc đời sắc sắc không không
Thì thôi ta cứ hết lòng vì nhau
ღღღღღTài sản của Xuân Thanh (View All Items) ღღღღღ
Reply
Những người đã cảm ơn vtdcomputer , TruongVanTruong
#8
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."
Chữ ký của ngamyeuem Hãy chia sẻ kinh nghiệm cùng mình trên ThuThuatAccess nhé! Chúc vui vẻ rose
Reply
Những người đã cảm ơn
#9
(14-08-12, 10:50 PM)ngamyeuem Đã viết: 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."

1/ Hàm đọc đúng.
2/ Thay
Mã:
thongbaoloi:
kqtqua = "loi cong thuc"

thành

Mã:
thongbaoloi:
KetQua = "loi cong thuc"
Chữ ký của Xuân Thanh Trăm năm trước thì ta chưa gặp
Trăm năm sau biết gặp được không?
Cuộc đời sắc sắc không không
Thì thôi ta cứ hết lòng vì nhau
ღღღღღTài sản của Xuân Thanh (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#10
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 sad
Chữ ký của uronmapu Cảm ơn cả nhà

Để học Access không nên ngại đặt câu hỏi


Uron
Reply
Những người đã cảm ơn camau


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  Lấy về số seri CPU, ổ cứng MainBoard trong Access Noname 33 12,286 08-06-16, 11:23 PM
Bài mới nhất: maidinhdan
  [Thủ Thuật] Ẩn record trong table theo ngày tháng tvn_hut 6 486 24-04-16, 01:00 AM
Bài mới nhất: tvn_hut
  Thuộc tính Startup MS Access toàn tập với VBA Noname 2 2,731 18-04-16, 04:50 PM
Bài mới nhất: ongke0711
  Msg Box tiếng Việt Unicode có định dạng chữ đậm tranthanhan1962 13 2,263 30-01-16, 12:39 AM
Bài mới nhất: khanghychu
  [Thủ Thuật] Hỏi_Xác định phiên bản Access đang dùng maidinhdan 1 379 18-12-15, 08:43 AM
Bài mới nhất: ongke0711

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ