Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
[blue]Option Explicit
' Necessary constants for hooking
Private Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5
' Working variables that require global scope in hooking module
Private hHook As Long
' The API declarations we need for hooking
Public 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
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
' Utility API declarations
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
' Necessary in VBA hosts since we generall won't have an hInstance
Public Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
' SOme constants for messing about a bit with the messagebox display
Private Const GWL_STYLE = (-16)
Private Const ES_CENTER = &H1&
Private Const WM_SETFONT = &H30
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
' Our wrapper for the normal MsgBox function
' this version works in Word
Public Function vbMsgBox(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String, Optional HelpFile As String, Optional Context As Long) As Long
hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProc, GetModuleHandle("winword.exe"), 0&)
vbMsgBox = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
End Function
Private Function WinProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim hwndCaption As Long
Dim CurrentStyle As Long
Dim ClassName As String
Dim myFont As IFont
Set myFont = UserForm1.Font
If lMsg = HCBT_ACTIVATE Then
hwndCaption = GetWindow(wParam, GW_CHILD)
Do Until GetClass(hwndCaption) = "Static"
hwndCaption = GetWindow(hwndCaption, GW_HWNDNEXT)
Loop
CurrentStyle = GetWindowLong(hwndCaption, GWL_STYLE)
SetWindowLong hwndCaption, GWL_STYLE, CurrentStyle Or ES_CENTER
SendMessage hwndCaption, WM_SETFONT, myFont.hFont, 0&
UnhookWindowsHookEx hHook
End If
WinProc = False
End Function[/blue]
[blue]Private Sub CommandButton1_Click()
vbMsgBox "Here we go", , "Just an example"
End Sub[/blue]