Mẹo viết được Unicode trong MsgBox của VBA

Nếu ai Từng lập trình VBA chắc hẳn sẽ thấy một sự rất bất cập khi trong VBA mình ghi thông báo bằng tiếng việt mà nó chả hiểu gì, cho ra toàn ký tự linh tinh hôm này mình giới thiệu một bài biết của tác giả Nguyễn Duy Tuân từng chia sẻ kinh nghiệm về cách viết Unicode trong MsgBox của VBA:

Cách làm như sau: (nhờ  windows API hỗ trợ)
+ Hook đúng cửa sổ MsgBox
+ Hỗ trợ Unicode
+ Giải phóng việc Hook trước đó an toàn.



Bổ sung thêm 3 hàm Windows API

1 2 3 4

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 GetActiveWindow Lib "user32.dll" () As Long

• Hàm GetClassName để kiểm tra loại của sổ.
• Hàm MessageBox để thay thế MsgBox trong VBA-->Gải pháp cho Unicode.
• Hàm GetActiveWindow để nhận điều khiển (Handle) của cửa sổ hiện thời.

Viết lại hàm MsgBoxHookProc

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34

Private Function MsgBoxHookProc(ByVal lMsg As Long, _                                 ByVal wParam As Long, _                                 ByVal lParam As Long) As Long       If lMsg = HCBT_ACTIVATE Then 'Kiểm tra cửa sổ hoạt động           'Modified by Nguyen Duy Tuan         'Begin checking class for MsgBox Window         'wParam is the handle of Window         Dim cClsName As String 'Nhận tên Class của cửa sổ         Dim x As Long 'Xác định số ký tự của chỗi                   cClsName = Space(32)         x = GetClassName(wParam, cClsName, 32)         cClsName = Left(cClsName, x) [COLOR=SeaGreen]'string convertion[/COLOR]                   If cClsName = "#32770" Then [COLOR=SeaGreen]'Kiểm tra Class có phải của cửa sổ MsgBox không[/COLOR]              ' Change position            SetWindowPos wParam, 0, msgbox_x, msgbox_y, _                         0, 0, SWP_NOSIZE + SWP_NOZORDER       ' Release the Hook            UnhookWindowsHookEx hHook            hHook = 0            MsgBoxHookProc = True         End If     End If        MsgBoxHookProc = False End Function

Những Addin của tác giả từng cung cấp đóng góp cộng đồng tại đây