maidinhdan > 30-07-15, 12:00 PM
![[Hình: DemohinhTBTV.png]](https://sites.google.com/site/thuthuataccess2003/home/demo-hinh/DemohinhTBTV.png)
![[Hình: Demohinh8TBTiengviet.png]](https://sites.google.com/site/thuthuataccess2003/home/demo-hinh/Demohinh8TBTiengviet.png)
![[Hình: TBtiengvietLoai10.png]](https://sites.google.com/site/thuthuataccess2003/home/demo-hinh/TBtiengvietLoai10.png)
maidinhdan > 31-07-15, 10:10 PM
![[Hình: vbaunicode.png]](http://dl.dropbox.com/u/38360355/pic/vbaunicode.png)
MTNQ > 02-08-15, 08:46 AM
(30-07-15, 12:00 PM)maidinhdan Đã viết: Sau nhiều lần tìm kiếm, sưu tâm về các kiểu thông báo tiếng việt trên Access.
Mạng phép xin tổng hợp tạo thành 1 Demo để cho ai có nhu cầu tìm hiểu và so sánh đánh giá cái nào hay hơn để có thể áp dụng cho bạn thân.
Nếu những bài tông hợp này còn chưa đủ xin các bạn đóng góp thêm
...
![[Hình: 3176201699_1616880993_574_574.jpg]](http://d.f21.photo.zdn.vn/upload/original/2015/08/02/07/44/3176201699_1616880993_574_574.jpg)
Function fTxt(strID As String, Optional i As Integer = 1) As String
    Dim fldName As String
    Dim fldNum As Integer
    fldNum = CurrentDb.TableDefs("tblTiengViet").Fields.Count
    If i < 1 Or i >= fldNum Then
        MsgBox "Tham so i phai >0 va <" & fldNum, , "Loi goi ham fTxt"
        Exit Function
    End If
    
    fldName = CurrentDb.TableDefs("tblTiengViet").Fields(i).Name
    fTxt = Nz(DLookup("[" & fldName & "]", "[tblTiengViet]", "[TVID] = '" & strID & "'"))
   
End Function
Function fTitle(Optional i As Integer = 1) As String
    Dim fldName As String
    Dim fldNum As Integer
    fldNum = CurrentDb.TableDefs("tblTiengViet").Fields.Count
    If i < 1 Or i >= fldNum Then
        MsgBox "Tham so i phai >0 va <" & fldNum, , "Loi goi ham fTitle"
        Exit Function
    End If
    
    fldName = CurrentDb.TableDefs("tblTiengViet").Fields(i).Name
    fTitle = Nz(DLookup("[" & fldName & "]", "[tblTiengViet]", "[TVID] = 'tit'"))
   
End FunctionMsgBox fTxt("test"), vbExclamation, fTitleMsgBox fTxt("test", 1), vbExclamation, fTitle(1)MsgBox ChrW(272) & "ây là MsgBox Ti" & ChrW(7871) & "ng Vi" & ChrW(7879) & "t!", vbInformation, "Test MsgBox"
MTNQ > 02-08-15, 04:31 PM
Function fMsgBoxTimer(strTxt As String, Optional intType As Integer, _
   Optional strTitle As String, Optional ingTime As Integer = 3) As Integer
   Dim objShell As Object
   Set objShell = CreateObject("WScript.Shell")
   
   If strTitle = vbNullString Then strTitle = Application.Name
   
   fMsgBoxTimer = objShell.PopUp(strTxt, ingTime, strTitle, intType)
   Set objShell = Nothing
End FunctionfMsgBoxTimer "Thong bao nay se tu tat sau 1 giay! ", vbInformation, "Test MsgBox", 1fMsgBoxTimer ChrW(272) & "ây là MsgBox Ti" & ChrW(7871) & "ng Vi" & ChrW(7879) & "t!", vbInformation, "Test MsgBox", 0
 maidinhdan > 03-08-15, 11:28 AM
(02-08-15, 08:46 AM)MatTroiNguQuen Đã viết: Còn một thủ thuật rất hay của bác Ngọc (paulsteigel), Việt hóa hoàn toàn MsgBox:
mdlMSG (Click to View)
MTNQ thêm vào 2 hàm sau để câu lệnh gọi hàm MsgBox nhìn gọn gàng hơn:
Demo MsgBoxTV.rar
P/S: Trong ví dụ MTNQ thay hàm MsgBox của bác Ngọc thành fMsgBox để phân biệt với hàm MsgBox của hệ thống, có gì sai bác bỏ qua nhé
paulsteigel > 03-08-15, 02:24 PM
(03-08-15, 11:28 AM)maidinhdan Đã viết: .....
Option Explicit
'=======================================================
' Module for Vietnamized MsgBox function
' This overide default VBA MsgBox function with some small
' modifications of text, button caption....
' Use this MsgBox function like it is in default VBA IDE
'=======================================================
' Import
#If VBA7 Then
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
     
    Private Declare PtrSafe Function SetDlgItemText Lib "user32" _
        Alias "SetDlgItemTextW" _
        (ByVal hDlg As LongPtr, _
         ByVal nIDDlgItem As LongPtr, _
         ByVal lpString As String) As LongPtr
     
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
        Alias "SetWindowsHookExA" _
        (ByVal idHook As LongPtr, _
         ByVal lpfn As LongPtr, _
         ByVal hmod As LongPtr, _
         ByVal dwThreadID As LongPtr) As LongPtr
     
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _
        (ByVal hHook As LongPtr) As LongPtr
     
    ' Handle to the Hook procedure
    Private hHook As LongPtr
#Else
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
     
    Private Declare Function SetDlgItemText Lib "user32" _
        Alias "SetDlgItemTextW" _
        (ByVal hDlg As Long, _
         ByVal nIDDlgItem As Long, _
         ByVal lpString As String) As Long
     
    Private Declare Function SetWindowsHookEx Lib "user32" _
        Alias "SetWindowsHookExA" _
        (ByVal idHook As Long, _
         ByVal lpfn As Long, _
         ByVal hmod As Long, _
         ByVal dwThreadID As Long) As Long
     
    Private Declare Function UnhookWindowsHookEx Lib "user32" _
        (ByVal hHook As Long) As Long
     
    ' Handle to the Hook procedure
    Private hHook As Long
#End If
' Hook type
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
 
' Constants
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
' Modify this code for English
Private StrYes As String
Private StrNo As String
Private StrOK As String
Private StrCancel As String
Private StrRetry As String
Private StrIgnore As String
Private StrAbort As String
Private Enum MsoAlertCancelType
    msoAlertCancelDefault = &HFFFFFFFF
    msoAlertCancelFifth = 4
    msoAlertCancelFirst = 0
    msoAlertCancelFourth = 3
    msoAlertCancelSecond = 1
    msoAlertCancelThird = 2
End Enum
' Application title
Const App_Title = "Sample messagebox"
Function MsgBox(MessageTxt As String, Optional msgStyle As VbMsgBoxStyle, Optional DlgCaption As String = "") As VbMsgBoxResult
    Beep
    Dim msgBoxIcon As Long, msgButton As Long, btnStyle As Long, ErrLoop As Boolean
    Dim ButtonDefault As Long
    
    ' Determine what button is default....
    Dim btnArr As Variant, i As Long
    btnArr = Array(0, 256, 512, 768)
    For i = 0 To UBound(btnArr)
        btnStyle = msgStyle - btnArr(i)
        If btnStyle < 0 Then
            ButtonDefault = i - 1
            btnStyle = msgStyle - btnArr(i - 1)
            ErrLoop = True
            Exit For
        End If
    Next
    
    ' Determine Icon...
    btnArr = Array(0, 16, 32, 48, 64)
    For i = 0 To UBound(btnArr)
        msgButton = btnStyle - btnArr(i)
        If msgButton <= 0 Then
            If msgButton = 0 Then
                msgBoxIcon = i
                btnStyle = btnStyle - btnArr(i)
            Else
                msgBoxIcon = i - 1
                btnStyle = btnStyle - btnArr(i - 1)
            End If
            ErrLoop = True
            Exit For
        End If
    Next
    If ErrLoop Then
        ' get the button style
        If msgButton < 0 Then msgButton = btnStyle
        
        ' clear error if number of button is smaller than the default setting...
        If ButtonDefault > msgButton Then ButtonDefault = msgButton
    Else
        ButtonDefault = 0
        msgButton = 0
        msgBoxIcon = 0
    End If
    ' Set Hook
    hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
    ' Display the messagebox
    MsgBox = Application.Assistant.DoAlert(IIf(DlgCaption <> "", DlgCaption, App_Title), _
        MessageTxt, msgButton, msgBoxIcon, ButtonDefault, msoAlertCancelDefault, True)
End Function
 
Private Function MsgBoxHookProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If lMsg = HCBT_ACTIVATE Then
        StrYes = "&C" & ChrW(243)
        StrNo = "&Kh" & ChrW(244) & "ng"
        StrOK = "Ch" & ChrW(7845) & "p nh" & ChrW(7853) & "&n"
        StrCancel = "&H" & ChrW(7911) & "y"
        StrRetry = "&Th" & ChrW(7917) & " l" & ChrW(7841) & "i"
        StrAbort = "&D" & ChrW(7915) & "ng"
        StrIgnore = "&B" & ChrW(7887) & " qua"
  
        SetDlgItemText wParam, IDYES, StrConv(StrYes, vbUnicode)
        SetDlgItemText wParam, IDNO, StrConv(StrNo, vbUnicode)
        SetDlgItemText wParam, IDCANCEL, StrConv(StrCancel, vbUnicode)
        SetDlgItemText wParam, IDOK, StrConv(StrOK, vbUnicode)
        SetDlgItemText wParam, IDABORT, StrConv(StrAbort, vbUnicode)
        SetDlgItemText wParam, IDRETRY, StrConv(StrRetry, vbUnicode)
        SetDlgItemText wParam, IDIGNORE, StrConv(StrIgnore, vbUnicode)
        ' Release the Hook
        UnhookWindowsHookEx hHook
    End If
    MsgBoxHookProc = False
End FunctionPrivate Enum MsoAlertCancelType
    msoAlertCancelDefault = &HFFFFFFFF
    msoAlertCancelFifth = 4
    msoAlertCancelFirst = 0
    msoAlertCancelFourth = 3
    msoAlertCancelSecond = 1
    msoAlertCancelThird = 2
End EnumMinh Tiên > 05-08-15, 05:06 PM
Minh Tiên > 06-08-15, 08:46 AM
ledangvan > 06-08-15, 09:40 AM
(06-08-15, 08:46 AM)Minh Tiên Đã viết: Bạn pausteigel chỉ giúp cách bổ sung đoạn code:
Private Enum MsoAlertCancelType
msoAlertCancelDefault = &HFFFFFFFF
msoAlertCancelFifth = 4
msoAlertCancelFirst = 0
msoAlertCancelFourth = 3
msoAlertCancelSecond = 1
msoAlertCancelThird = 2
End Enum
vào chỗ nào ?
Mình copy vào Module trên cứ báo lỗi dòng Private Enum MsoAlertCancelType.
Thân./.
maidinhdan > 06-08-15, 10:04 AM
(06-08-15, 08:46 AM)Minh Tiên Đã viết: Bạn pausteigel chỉ giúp cách bổ sung đoạn code:Enum MsoAlertCancelType
vào chỗ nào ?
Mình copy vào Module trên cứ báo lỗi dòng Private Enum MsoAlertCancelType.
Thân./.