gmulhall
04-20-2009, 03:11 AM
Hi,
I have an Excel VBA app which runs a timer and then pops up a userform. When the form pops up I'd like the excel taskbar window to flash to get the users attention. App is Excel 2003 running on Win XP.
I found the following code - but cannot make it work. Is it correct and where sould it be placed ? In a module ? In the userform ? In the timer proc ? Some combination ? :think:
Thanks as always.
Option Explicit
Private Type FLASHWINFO
cbSize As Long
Hwnd As Long
dwFlags As Long
uCount As Long
dwTimeout As Long
End Type
Private Const FLASHW_TRAY = 2
Private Declare Function LoadLibrary Lib "kernel32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long
Private Declare Function FlashWindowEx Lib "user32" _
(FWInfo As FLASHWINFO) As Boolean
Public Sub FlashWindow(Hwnd As Long, _
Optional NumberOfFlashes As Integer = 5)
'Purpose: Flashes a Window in the taskbar in order to notify
'a user of an event within a program
'Parameters: Hwnd=hwnd of frm to flash
'NumberofFlashes = Number of times to
'flash
'Notes: WINDOWS 98 OR 2000 is REQUIRED
'Uses FlashWindowEx API, which substitutes
'for bringing you window to the foreground
'obtrusively (e.g., on startup or when siginficant
'event occurs in your program) Windows 98/2000 no
'longer permits this
'Example:
'FlashWindow me.hwnd
'Prevent Errors by checking if
'the API function is available on the
'Current OS
If Not APIFunctionPresent("FlashWindowEx", "user32") _
Then Exit Sub
Dim bRet As Boolean
Dim udtFWInfo As FLASHWINFO
With udtFWInfo
.cbSize = 20
.Hwnd = Hwnd
.dwFlags = FLASHW_TRAY
.uCount = NumberOfFlashes 'flash window 5 times
.dwTimeout = 0
End With
bRet = FlashWindowEx(udtFWInfo)
End Sub
Private Function APIFunctionPresent(ByVal FunctionName _
As String, ByVal DllName As String) As Boolean
'USAGE:
'Dim bAvail as boolean
'bAvail = APIFunctionPresent("GetDiskFreeSpaceExA", "kernel32")
Dim lHandle As Long
Dim lAddr As Long
lHandle = LoadLibrary(DllName)
If lHandle <> 0 Then
lAddr = GetProcAddress(lHandle, FunctionName)
FreeLibrary lHandle
End If
APIFunctionPresent = (lAddr <> 0)
End Function
I have an Excel VBA app which runs a timer and then pops up a userform. When the form pops up I'd like the excel taskbar window to flash to get the users attention. App is Excel 2003 running on Win XP.
I found the following code - but cannot make it work. Is it correct and where sould it be placed ? In a module ? In the userform ? In the timer proc ? Some combination ? :think:
Thanks as always.
Option Explicit
Private Type FLASHWINFO
cbSize As Long
Hwnd As Long
dwFlags As Long
uCount As Long
dwTimeout As Long
End Type
Private Const FLASHW_TRAY = 2
Private Declare Function LoadLibrary Lib "kernel32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long
Private Declare Function FlashWindowEx Lib "user32" _
(FWInfo As FLASHWINFO) As Boolean
Public Sub FlashWindow(Hwnd As Long, _
Optional NumberOfFlashes As Integer = 5)
'Purpose: Flashes a Window in the taskbar in order to notify
'a user of an event within a program
'Parameters: Hwnd=hwnd of frm to flash
'NumberofFlashes = Number of times to
'flash
'Notes: WINDOWS 98 OR 2000 is REQUIRED
'Uses FlashWindowEx API, which substitutes
'for bringing you window to the foreground
'obtrusively (e.g., on startup or when siginficant
'event occurs in your program) Windows 98/2000 no
'longer permits this
'Example:
'FlashWindow me.hwnd
'Prevent Errors by checking if
'the API function is available on the
'Current OS
If Not APIFunctionPresent("FlashWindowEx", "user32") _
Then Exit Sub
Dim bRet As Boolean
Dim udtFWInfo As FLASHWINFO
With udtFWInfo
.cbSize = 20
.Hwnd = Hwnd
.dwFlags = FLASHW_TRAY
.uCount = NumberOfFlashes 'flash window 5 times
.dwTimeout = 0
End With
bRet = FlashWindowEx(udtFWInfo)
End Sub
Private Function APIFunctionPresent(ByVal FunctionName _
As String, ByVal DllName As String) As Boolean
'USAGE:
'Dim bAvail as boolean
'bAvail = APIFunctionPresent("GetDiskFreeSpaceExA", "kernel32")
Dim lHandle As Long
Dim lAddr As Long
lHandle = LoadLibrary(DllName)
If lHandle <> 0 Then
lAddr = GetProcAddress(lHandle, FunctionName)
FreeLibrary lHandle
End If
APIFunctionPresent = (lAddr <> 0)
End Function