barev
10-17-2010, 05:04 AM
Hello,
I am trying to use the following proof-of-concept code to show a balloon tooltip from a VBA form, which has been sent to the system tray with a generic excel icon. The code is executed in Excel 2007 on a Windows XP SP3 machine. I have one userform with two command buttons and one module in the project. The code is as follows:
'***************** START USERFORM1 CODE ******************
Private Sub CommandButton1_Click()
Dim Me_hWnd As Long, Me_Icon As Long, Me_Icon_Handle As Long, IconPath As String _
Me_hWnd = FindWindowd("ThunderDFrame", Me.Caption)
IconPath = Application.Path & Application.PathSeparator & "excel.exe" _
Me_Icon_Handle = ExtractIcond(0, IconPath, 0)
Hook Me_hWnd
AddIconToTray Me_hWnd, 0, Me_Icon_Handle, "Double Click to re-open userform"
BalloonPopUp
Me.Hide
End Sub
Private Sub CommandButton2_Click()
Application.Visible = True
Unload Me
End Sub
Private Sub UserForm_Activate()
RemoveIconFromTray
Unhook
End Sub
Private Sub UserForm_Initialize()
Application.Visible = False
End Sub
'****************** END USERFORM1 CODE *******************
'***************** START MODULE CODE ******************
Option Explicit
Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal _
As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBL = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBL = &H206
Public Const WM_ACTIVATEAPP = &H1C
Public Const NIS_HIDDEN = &H1
Public Const NIS_SHAREDICON = &H2
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIF_STATE = &H8
Public Const NIF_INFO = &H10
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const MAX_TOOLTIP As Integer = 64
Public Const GWL_WNDPROC = (-4)
'shell version / NOTIFIYICONDATA struct size constants
Public Const NOTIFYICONDATA_V1_SIZE As Long = 88 'pre-5.0 structure size
Public Const NOTIFYICONDATA_V2_SIZE As Long = 488 'pre-6.0 structure size
Public Const NOTIFYICONDATA_V3_SIZE As Long = 504 '6.0+ structure size
Public NOTIFYICONDATA_SIZE As Long
Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
dwState As Long
dwStateMask As Long
szInfo As String * 256
uTimeout As Long
szInfoTitle As String * 64
dwInfoFlags As Long
End Type
Public nfIconData As NOTIFYICONDATA
' list the icon types for the balloon message..
Public Const vbNone = 0
Public Const vbInformation = 1
Public Const vbExclamation = 2
Public Const vbCritical = 3
Private FHandle As Long
Private WndProc As Long
Private Hooking As Boolean
Public Sub Hook(Lwnd As Long)
If Hooking = False Then
FHandle = Lwnd
WndProc = SetWindowLong(Lwnd, GWL_WNDPROC, AddressOf WindowProc)
Hooking = True
End If
End Sub
Public Sub Unhook()
If Hooking = True Then
SetWindowLong FHandle, GWL_WNDPROC, WndProc
Hooking = False
End If
End Sub
Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Hooking Then
If lParam = WM_LBUTTONDBL Then
UserForm1.Show 1
WindowProc = True
' Unhook
Exit Function
End If
WindowProc = CallWindowProc(WndProc, hw, uMsg, wParam, lParam)
End If
End Function
Public Sub RemoveIconFromTray()
Shell_NotifyIcon NIM_DELETE, nfIconData
End Sub
Public Sub AddIconToTray(MeHwnd As Long, MeIcon As Long, MeIconHandle As Long, Tip As String)
With nfIconData
.hWnd = MeHwnd
.uID = MeIcon
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
.uCallbackMessage = WM_RBUTTONUP
.dwState = NIS_SHAREDICON
.hIcon = MeIconHandle
.szTip = Tip & Chr$(0)
.cbSize = NOTIFYICONDATA_V3_SIZE
End With
Shell_NotifyIcon NIM_ADD, nfIconData
End Sub
Public Sub BalloonPopUp()
' ok, create a balloon popup..
With nfIconData
.dwInfoFlags = vbInformation
.uFlags = NIF_INFO
.szInfoTitle = "ToolTip" & vbNullChar
.szInfo = "Message" & vbNullChar
End With
' ok, write it to the system tray icon
Shell_NotifyIcon NIM_MODIFY, nfIconData
End Sub
Function FindWindowd(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
FindWindowd = FindWindow(lpClassName, lpWindowName)
End Function
Function ExtractIcond(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
ExtractIcond = ExtractIcon(hInst, lpszExeFileName, nIconIndex)
End Function
Sub ShowUserForm()
Application.Visible = False
UserForm1.Show 1
End Sub
'****************** END MODULE CODE *******************
When running the form if commandbutton1 is clicked, the excel sheet and form are hidden, a generic excel icon is shown in the system tray with a balloon tooltip.
The problem is the code sort of works and a balloon tooltip is shown from the tray icon, however the title, text and icon in the tooltip are not shown. I basically get the following output 4696 (check the attached screenshot).
Does anyone know the reason for this and how to achieve the expected result? Thanks for the help in advance!
I am trying to use the following proof-of-concept code to show a balloon tooltip from a VBA form, which has been sent to the system tray with a generic excel icon. The code is executed in Excel 2007 on a Windows XP SP3 machine. I have one userform with two command buttons and one module in the project. The code is as follows:
'***************** START USERFORM1 CODE ******************
Private Sub CommandButton1_Click()
Dim Me_hWnd As Long, Me_Icon As Long, Me_Icon_Handle As Long, IconPath As String _
Me_hWnd = FindWindowd("ThunderDFrame", Me.Caption)
IconPath = Application.Path & Application.PathSeparator & "excel.exe" _
Me_Icon_Handle = ExtractIcond(0, IconPath, 0)
Hook Me_hWnd
AddIconToTray Me_hWnd, 0, Me_Icon_Handle, "Double Click to re-open userform"
BalloonPopUp
Me.Hide
End Sub
Private Sub CommandButton2_Click()
Application.Visible = True
Unload Me
End Sub
Private Sub UserForm_Activate()
RemoveIconFromTray
Unhook
End Sub
Private Sub UserForm_Initialize()
Application.Visible = False
End Sub
'****************** END USERFORM1 CODE *******************
'***************** START MODULE CODE ******************
Option Explicit
Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal _
As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBL = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBL = &H206
Public Const WM_ACTIVATEAPP = &H1C
Public Const NIS_HIDDEN = &H1
Public Const NIS_SHAREDICON = &H2
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIF_STATE = &H8
Public Const NIF_INFO = &H10
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const MAX_TOOLTIP As Integer = 64
Public Const GWL_WNDPROC = (-4)
'shell version / NOTIFIYICONDATA struct size constants
Public Const NOTIFYICONDATA_V1_SIZE As Long = 88 'pre-5.0 structure size
Public Const NOTIFYICONDATA_V2_SIZE As Long = 488 'pre-6.0 structure size
Public Const NOTIFYICONDATA_V3_SIZE As Long = 504 '6.0+ structure size
Public NOTIFYICONDATA_SIZE As Long
Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
dwState As Long
dwStateMask As Long
szInfo As String * 256
uTimeout As Long
szInfoTitle As String * 64
dwInfoFlags As Long
End Type
Public nfIconData As NOTIFYICONDATA
' list the icon types for the balloon message..
Public Const vbNone = 0
Public Const vbInformation = 1
Public Const vbExclamation = 2
Public Const vbCritical = 3
Private FHandle As Long
Private WndProc As Long
Private Hooking As Boolean
Public Sub Hook(Lwnd As Long)
If Hooking = False Then
FHandle = Lwnd
WndProc = SetWindowLong(Lwnd, GWL_WNDPROC, AddressOf WindowProc)
Hooking = True
End If
End Sub
Public Sub Unhook()
If Hooking = True Then
SetWindowLong FHandle, GWL_WNDPROC, WndProc
Hooking = False
End If
End Sub
Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Hooking Then
If lParam = WM_LBUTTONDBL Then
UserForm1.Show 1
WindowProc = True
' Unhook
Exit Function
End If
WindowProc = CallWindowProc(WndProc, hw, uMsg, wParam, lParam)
End If
End Function
Public Sub RemoveIconFromTray()
Shell_NotifyIcon NIM_DELETE, nfIconData
End Sub
Public Sub AddIconToTray(MeHwnd As Long, MeIcon As Long, MeIconHandle As Long, Tip As String)
With nfIconData
.hWnd = MeHwnd
.uID = MeIcon
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
.uCallbackMessage = WM_RBUTTONUP
.dwState = NIS_SHAREDICON
.hIcon = MeIconHandle
.szTip = Tip & Chr$(0)
.cbSize = NOTIFYICONDATA_V3_SIZE
End With
Shell_NotifyIcon NIM_ADD, nfIconData
End Sub
Public Sub BalloonPopUp()
' ok, create a balloon popup..
With nfIconData
.dwInfoFlags = vbInformation
.uFlags = NIF_INFO
.szInfoTitle = "ToolTip" & vbNullChar
.szInfo = "Message" & vbNullChar
End With
' ok, write it to the system tray icon
Shell_NotifyIcon NIM_MODIFY, nfIconData
End Sub
Function FindWindowd(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
FindWindowd = FindWindow(lpClassName, lpWindowName)
End Function
Function ExtractIcond(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
ExtractIcond = ExtractIcon(hInst, lpszExeFileName, nIconIndex)
End Function
Sub ShowUserForm()
Application.Visible = False
UserForm1.Show 1
End Sub
'****************** END MODULE CODE *******************
When running the form if commandbutton1 is clicked, the excel sheet and form are hidden, a generic excel icon is shown in the system tray with a balloon tooltip.
The problem is the code sort of works and a balloon tooltip is shown from the tray icon, however the title, text and icon in the tooltip are not shown. I basically get the following output 4696 (check the attached screenshot).
Does anyone know the reason for this and how to achieve the expected result? Thanks for the help in advance!