Sau 1 hồi lặn hụp trên mạng thì gặp lại được Pác Tuấn tác giả của đoạn code cũ đó ngày xưa.....và Pác có chia sẻ cho đoạn code mới dùng được trên win 64 bit.....sẵn tiện mình cũng chia sẽ lại cùng với mọi người.
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare PtrSafe Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function MessageBox Lib "user32.dll" Alias "MessageBoxW" (ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As LongPtr
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
' Handle to the Hook procedure
Private hHook As LongPtr
#Else
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () 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 SetWindowPos 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
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxW" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
'Handle to the Hook procedure
Private hHook As Long
#End If
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const SM_CXBORDER = 5
Private Const SM_CYBORDER = 6
Private Const SM_CXEDGE = 45
Private Const SM_CYEDGE = 46
Private Const SM_CXFRAME = &H20
Private Const SM_CYFRAME = 33
'Hook type
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
'SetWindowPos Flags
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
'Position for UniMsgBoxPos
Private msgbox_x As Long
Private msgbox_y As Long
'Position Flags for UniMsgBoxPos
Const POS_RIGHT = 10000
Const POS_BOTTOM = 10000
Const POS_CENTER_X = -1
Const POS_CENTER_Y = -1
'SOURCE CODE for UniMsgBoxPos
'Created by: Nguyen Duy Tuan
Public Function UniMsgBoxPos(strPromt As String, Optional vbButtons As VbMsgBoxStyle = vbOKOnly, Optional strTitle As String = "", Optional xPos As Long = -1, Optional yPos As Long = -1)
' Store position
msgbox_x = xPos
msgbox_y = yPos
' Set Hook
hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
' Run MessageBox
'Modified by Nguyen Duy Tuan
UniMsgBoxPos = MessageBox(GetActiveWindow, StrConv(strPromt, vbUnicode), StrConv(IIf(strTitle = "", Application.Name, strTitle), vbUnicode), vbButtons)
'MsgBox for unicode basic here:
'
https://bluesofts.net/Lap-trinh-VBA/co-ban/Hien-thi-MsgBox-chu-co-dau-tieng-viet---Unicode
If hHook <> 0 Then ' Release the Hook again (important!)
UnhookWindowsHookEx hHook
End If
End Function
#If VBA7 Then
Private Function MsgBoxHookProc(ByVal lMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
#Else
Private Function MsgBoxHookProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
If lMsg = HCBT_ACTIVATE Then
'Modified by Nguyen Duy Tuan
'Begin checking class for MsgBox Window
'wParam is the handle of MsgBox (Window)
Dim sClsName As String
Dim x&, y&, rc As RECT, rc2 As RECT, rc3 As RECT
Dim hd, hWndTray
sClsName = Space(32)
x = GetClassName(wParam, sClsName, 32)
sClsName = Left(sClsName, x) 'string convertion
If sClsName = "#32770" Then 'Active Window Is MsgBox
hd = GetDesktopWindow
hWndTray = FindWindow("Shell_TrayWnd", vbNullString)
GetWindowRect hWndTray, rc3 'SysTray
GetClientRect hd, rc2 'Desktop
GetWindowRect wParam, rc 'MsgBox
x = msgbox_x: y = msgbox_y
If msgbox_x = POS_CENTER_X Or msgbox_y = POS_CENTER_Y Then
If msgbox_x = POS_CENTER_X Then
x = ((rc2.Right - rc2.Left) - (rc.Right - rc.Left)) \ 2
End If
If msgbox_y = POS_CENTER_Y Then
y = ((rc2.Bottom - rc2.Top) - (rc.Bottom - rc.Top)) \ 2
End If
End If
If msgbox_x = POS_RIGHT Then
x = rc2.Right - (rc.Right - rc.Left) + GetSystemMetrics(SM_CXBORDER) + GetSystemMetrics(SM_CXEDGE) + GetSystemMetrics(SM_CXFRAME)
End If
If msgbox_y = POS_BOTTOM Then
y = rc2.Bottom - (rc.Bottom - rc.Top)
End If
If msgbox_y = POS_BOTTOM Or msgbox_y = POS_CENTER_Y Then
y = y - GetSystemMetrics(SM_CYBORDER) + GetSystemMetrics(SM_CYEDGE) + GetSystemMetrics(SM_CYFRAME) - (rc3.Bottom - rc3.Top)
End If
If msgbox_x = 0 Then
x = x - GetSystemMetrics(SM_CXBORDER) - GetSystemMetrics(SM_CXEDGE) - GetSystemMetrics(SM_CXFRAME)
End If
'Change position
SetWindowPos wParam, 0, x, y, 0, 0, SWP_NOSIZE + SWP_NOZORDER
'Release the Hook
UnhookWindowsHookEx hHook
hHook = 0
MsgBoxHookProc = True
Exit Function
End If
End If
MsgBoxHookProc = False
End Function
www.giaiphapexcel.com
. Bài viết gốc cùng mã nguồn hàm UniMsgBox, UniMsgBoxPos hỗ trợ unicode + tùy biến vị trí xuất hiện, file ví dụ tại đây:
