Tổng hợp các bài liên quan đến Msgbox

[levanduyet]

1. Làm thế nào để thay thế các chữ OK, CANCEL,... nhàm chán của Msgbox.

Chúng ta phải dùng kỹ thuật Hook. Các bạn hãy đưa đoạn mã sau vào một module trong cửa sổ VBE.

Private sButton1 As String
Private sButton2 As String
Private sCaption As String
Private sText As String
Private Const MB_ICONQUESTION As Long = &H20&
Private Const MB_OKCANCEL As Long = &H1&
Private Const MB_TASKMODAL As Long = &H2000&
Private Const IDPROMPT = &HFFFF&
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5
Private Type MSGBOX_HOOK_PARAMS
    hwndOwner As Long
    hHook As Long
End Type
Private MSGHOOK As MSGBOX_HOOK_PARAMS
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (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 SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Function [COLOR="Red"][B]myMessageBox[/B][/COLOR](hwndThreadOwner As Long, hwndOwner As Long, strCaption As String, strText As String, strButton1 As String, strButton2 As String) As Long
    sButton1 = strButton1
    sButton2 = strButton2
    sCaption = strCaption
    sText = strText
    Dim hInstance As Long, hThreadId As Long
     hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE)
    hThreadId = GetCurrentThreadId()
    With MSGHOOK
        .hwndOwner = hwndOwner
        .hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, hInstance, hThreadId)
    End With
    myMessageBox = MessageBox(hwndOwner, Space$(120), Space$(120), MB_OKCANCEL Or MB_ICONQUESTION)
End Function
Private Function [COLOR="Red"][B]MsgBoxHookProc[/B][/COLOR](ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = HCBT_ACTIVATE Then
        SetWindowText wParam, sCaption
        SetDlgItemText wParam, 1, sButton1
        SetDlgItemText wParam, 2, sButton2
        SetDlgItemText wParam, &HFFFF&, sText
        UnhookWindowsHookEx MSGHOOK.hHook
    End If
    MsgBoxHookProc = False
End Function

Sub [COLOR="Red"][B]Macro1[/B][/COLOR]()
    Dim msg    As Long
    msg = myMessageBox(0, GetDesktopWindow(), "Question", "Which one do you love,Word or Excel?", "Excel", "Word")
    If msg = 1 Then myMessageBox 0, GetDesktopWindow(), "I love Excel", "Which Version?", "Excel 97", "Excel 2007"
    If msg = 2 Then myMessageBox 0, GetDesktopWindow(), "I love Word", "Which Version?", "Word 97", "Word 2007"
End Sub

Sau đó các bạn hãy thực hiện Macro1, các bạn sẽ được toại nguyện.

Lê Văn Duyệt

 

[levanduyet]

2. MsgBoxClr - Tô màu nền và chữ cho MsgBox

Tác giả: Nguyễn Duy Tuân

Cũng tương tự tác giả dùng kỹ thuật Hook.

Gửi bạn mã nguồn về hàm MsgBoxClr. Hàm này cách sử dụng như hàm MsgBox, nhưng nó có thêm 2 đối số ở cuối là BackColor và ForeColor để tô màu nền và màu chữ cho MsgBox.

Hàm MsgBox vẫn sử dụng hàm gốc của VBA là MsgBox. Trước khi gọi hàm MsgBox(), tôi dùng thủ thuật hook của sổ, cấy vào nó một thủ tục "MsgBoxProc" để xử lý các thông điệp của Windows vẽ cửa sổ.

Qua ví dụ này các bạn thấy, có những thứ tưởng như rất khó nhưng với chút hiểu biết về lập trình Windows API chúng ta sẽ làm được!

Ta có thể đưa Progress, tô màu, unicode cho MsgBox, InputBox.

Function [COLOR="Red"]MsgBoxClr[/COLOR](ByVal Prompt As String, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal Title As String = vbNullString, Optional HelpFile As String = vbNullString, Optional ByVal Context As Long, Optional ByVal BackColor As Long = -1, Optional ByVal ForeColor As Long = -1) As VbMsgBoxResult
    Dim inst&
    inst = GetWindowLong(GetActiveWindow, GWL_HINSTANCE)
    With MSG
        .BackColor = BackColor
        .ForeColor = ForeColor
       [COLOR="SeaGreen"] 'This is where you need to Hook the MsgBox[/COLOR]
        .HOOK = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookMsgBox, inst, GetCurrentThreadId)
        MsgBoxClr = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
        [COLOR="SeaGreen"]'Remove the Hook[/COLOR]
        Call UnhookWindowsHookEx(.HOOK)
        .PrevProc = 0
    End With
End Function

Private Function [COLOR="Red"]MsgBoxProc[/COLOR](ByVal hwnd As Long, ByVal uMSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tLB As LOGBRUSH
    Select Case uMSG
        Case WM_CTLCOLORDLG, WM_CTLCOLORSTATIC
            If MSG.ForeColor <> -1 Then Call SetTextColor(wParam, MSG.ForeColor)
            If MSG.BackColor <> -1 Then Call SetBkColor(wParam, MSG.BackColor)
            'Create a Solid Brush using that Color
            If MSG.BackColor <> -1 Then
                tLB.lbColor = MSG.BackColor
                'Return the Handle to the Brush to Paint the MsgBox
                MsgBoxProc = CreateBrushIndirect(tLB)
                Exit Function
            End If
        Case WM_DESTROY
            'Remove the MsgBox Subclassing
            Call SetWindowLong(hwnd, GWL_WNDPROC, MSG.PrevProc)
    End Select
    MsgBoxProc = CallWindowProc(MSG.PrevProc, hwnd, uMSG, wParam, ByVal lParam)
End Function

[COLOR="SeaGreen"]'Test------------------------------------------------------------------------------------------------[/COLOR]
Sub TestMsgBox1()
    MsgBoxClr "Created by: Nguyen Duy Tuan - www.bluesofts.net", , "MsgBox with color", , , vbYellow, vbRed
End Sub

Các bạn có thể download file về xem mã nguồn.

Link tại đây.

 

[levanduyet]

Tham khảo thêm:

• Tham khảo 1.
• Tham khảo 2.

 

[levanduyet]

Hook và SubClassing là kỹ thuật tuy có cùng cơ chế, nhưng bản chất rất khác nhau.

SubClass là kỹ thuật có thể nói nôm na: "Sửa lại hàm xử lý Window của chính nó". Bởi mỗi window đều có Hàm xử lý Thông điệp chuẩn. Nên khi có nhu cầu ta sẽ thay thế cái hàm này bằng 1 hàm khác ... đương nhiên có cùng cấu trúc hàm và cách thức xử lý.

Việc mà ta thay thế hàm xử lý Window chuẩn trong VB gọi là SubClass. Nếu thành công chúng ta có được sự thay đổi khá nhiều vế chức năng và giao diện mà SubClass mang lại và đương nhiên KHÔNG ảnh hưởng đến HỆ THỐNG.

Còn đối với Hook thì khác.

Hook là kỹ thuật đón bắt thông điệp ở cấp Hệ thống hoặc cục bộ. Nhắc đến Hook trước tiên ta cần nghĩ ngay đến Event trong Window. Và Hook là kỹ thuật "bắt" dữ liệu của các EVENT mà Window và Người dùng phát sinh.

Ví dụ khi ta rê chuột. Ta có Event: Mouse_XXX và các dữ liệu quan trọng như:

- X, Y, Button của mouse ....
==> thì Hook cho phép chúng ta lấy tất cả các dữ liệu quan trọng đó.

Giống như SubClass, Hook cũng sử dụng một hàm xử lý. Tuy nhiên hàm của Hook đa dạng hơn và mỗi loại Hook có 1 hàm xử lý riêng. Thậm chí có tên cố định theo yêu cầu của Window.... Nếu đặt sai tên ... nó KHÔNG hoạt động.

Các Event nào không Hook thì chúng ta phải trả về cho Hệ thống. SubClass cũng vậy, chúng ta trả quyền xử lý cho Hệ thống nếu không cần thiết.

Và 1 điểm rất quan trong khi Hook, nếu Hook thành công thì chúng ta có được các dữ liệu rất hữu ích ở cấp Hệ thống, nhưng nếu không thành ... thì sẽ gặp sự cố Hệ thống. Có thể là treo máy, mất dữ liệu..... Cho nên hãy cẩn thận khi HOOK.

Các bạn có thể tham khảo thêm bài viết về Hook và SubClassing tại đây.

Tham khảo từ Microsoft.

 

[levanduyet]

3) Xác định vị trí để hiện Msgbox - Define a Position of MessageBox using VBA in Excel

Thông thường MsgBox sẽ hiện ra giữa màn hình. Chúng ta có thể thay đổi vị trí của nó dùng kỹ thuật HOOK trong VBA:

• Bạn phải tạo một CBT (A computer-based training) hook.
• Thực hiện một Message Box với CBT hook.
• Bắt lầy một HCBT_ACTIVATE message (thông điệp) trong thủ tục Hook.
• Thiết lập vị trí mới sử dụng hàm SetWindowPos.
• Bỏ (release) CBT hook ra.

Bạn hãy copy đoạn mã sau vào một module và thực hiện thủ tục TestMsgBox

Option Explicit
 
[COLOR="Lime"]' Quan trọng[/COLOR]
Private Declare Function [COLOR="Red"]UnhookWindowsHookEx[/COLOR] Lib "user32" _
    (ByVal hHook As Long) As Long
 
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
 
Private Declare Function [COLOR="Red"]SetWindowsHookEx [/COLOR]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 [COLOR="Red"]SetWindowPos[/COLOR] Lib "user32" _
    (ByVal hwnd As Long, _
     ByVal hWndInsertAfter As Long, _
     ByVal x As Long, _
     ByVal y As Long, _
     ByVal cx As Long, _
     ByVal cy As Long, _
     ByVal wFlags As Long) As Long
 
[COLOR="Lime"]' Quản lý thủ tục Hook - Handle to the Hook procedure[/COLOR]
Private hHook As Long
 
[COLOR="Lime"]' Vị trí[/COLOR]
Private msgbox_x As Long
Private msgbox_y As Long
 
[COLOR="Lime"]' Kiểu Hook[/COLOR]
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
 
' SetWindowPos Flags
Private Const SWP_NOSIZE = &H1      ' Giữ lại kích thước hiện tại - Retains the current size
Private Const SWP_NOZORDER = &H4    ' Retains the current Z order

Sub [COLOR="Red"]TestMsgBox[/COLOR]()
[COLOR="Lime"]    'Msgbox sẽ được hiện ở vị trí 400, 300[/COLOR]
    MsgBoxPos "Set non-Center Position", _
              vbOKOnly, _
              "Message Box Hooking", _
              400, 300
End Sub
 
Public Sub [COLOR="Red"]MsgBoxPos[/COLOR](strPromt As String, _
              vbButtons As VbMsgBoxStyle, _
              strTitle As String, _
              xPos As Long, _
              yPos As Long)
 
[COLOR="Lime"]    ' Lưu vị trí - Store position[/COLOR]
    msgbox_x = xPos
    msgbox_y = yPos
 
 [COLOR="Lime"]   ' Thiết lập Hook - Set Hook[/COLOR]
    hHook = SetWindowsHookEx(WH_CBT, _
                              AddressOf MsgBoxHookProc, _
                              0, _
                              GetCurrentThreadId)
 
   [COLOR="Lime"] ' Thực hiện thông báo - Run MessageBox[/COLOR]
    MsgBox strPromt, vbButtons, strTitle
End Sub
 
Private Function [COLOR="Red"]MsgBoxHookProc[/COLOR](ByVal lMsg As Long, _
                                ByVal wParam As Long, _
                                ByVal lParam As Long) As Long
    If lMsg = HCBT_ACTIVATE Then
[COLOR="Lime"]        ' Thay đổi vị trí - Change position[/COLOR]
        SetWindowPos wParam, 0, msgbox_x, msgbox_y, _
                     0, 0, SWP_NOSIZE + SWP_NOZORDER
 
[COLOR="Lime"]        ' Giải phóng (huỷ) Hook - Release the Hook[/COLOR]
        UnhookWindowsHookEx hHook
    End If
 
    MsgBoxHookProc = False
End Function

Nguồn tại đây.