 |
| Excel VBA Discuss using VBA for Excel programming. |
Welcome to the p2p.wrox.com Forums.
You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
|
|
|
|
January 8th, 2006, 09:02 PM
|
|
Authorized User
|
|
Join Date: Nov 2004
Posts: 36
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
Minimize Microsoft Excel in SysTray
Hi all,
I want to put Microsoft Excel in SysTray like when i will press Minimize button, Its window will hide and will not appear at Task bar, but only an icon will appear in Systray. So whenever i want to show Microsoft Excel again, i will click at this icon and it will show me Microsoft excel again.
I want to do all this task through code. any help will be highly appreciated.
Tayyab
__________________
Tiyyob
|
|
January 9th, 2006, 08:07 AM
|
|
Friend of Wrox
|
|
Join Date: Jun 2003
Posts: 173
Thanks: 0
Thanked 3 Times in 3 Posts
|
|
Tayyab,
I can do part of this for you but am having trouble getting it all out. You'll need to use some WinAPI calls to get this functionality. If you copy the code below into a new blank code module your project will be able to call the function ApplicationOff() which will send Excel to a Systray icon and will only expand Excel when the icon is clicked on. Note that you will not be able to put this code into a Class module as you are using callback procudres and it only works in normal code modules.
Code:
Option Explicit
' ***************************************************************
' Win API call flags
' ***************************************************************
' Unknown flags
Private Const WM_GETICON = &H7F
Private Const WM_SETICON = &H80
Private Const IMAGE_BITMAP = 0
Private Const IMAGE_ICON = 1
Private Const IMAGE_CURSOR = 2
Private Const LR_LOADFROMFILE = &H10
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
' SetWindowLongA flag
Private Const GWL_WNDPROC As Long = (-4)
' ShowWindow flags
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWRESTORE = 10
' SHGetFileInfo flags
Private Const SHGFI_ICON = &H100
Private Const SHGFI_DISPLAYNAME = &H200
Private Const SHGFI_TYPENAME = &H400
Private Const SHGFI_ATTRIBUTES = &H800
Private Const SHGFI_ICONLOCATION = &H1000
Private Const SHGFI_EXETYPE = &H2000
Private Const SHGFI_SYSICONINDEX = &H4000
Private Const SHGFI_LINKOVERLAY = &H8000
Private Const SHGFI_SELECTED = &H10000
Private Const SHGFI_ATTR_SPECIFIED = &H20000
Private Const SHGFI_LARGEICON = &H0
Private Const SHGFI_SMALLICON = &H1
Private Const SHGFI_OPENICON = &H2
Private Const SHGFI_SHELLICONSIZE = &H4
Private Const SHGFI_PIDL = &H8
Private Const SHGFI_USEFILEATTRIBUTES = &H10
' Shell_NotifyIcon Flags
Private Const NIM_ADD As Long = &H0
Private Const NIM_MODIFY As Long = &H1
Private Const NIM_DELETE As Long = &H2
' NOTIFYICONDATA flags
Private Const NIF_TIP As Long = &H4
Private Const NIF_MESSAGE As Long = &H1
Private Const NIF_ICON As Long = &H2
' Messages
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
' SHGetFileInfoA flags
Private Const FILE_ATTRIBUTE_NORMAL = &H80
' FindWindow flags
Const EXCEL_WIN_CLASS_NAME = "XLMAIN"
' ***************************************************************
' Declare Win API calls
' ***************************************************************
Private Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" ( _
ByVal hwnd As Long, _
ByVal nCmdShow As Long) _
As Long
Private Declare Function apiLoadImage Lib "user32" _
Alias "LoadImageA" ( _
ByVal hInst As Long, _
ByVal lpszName As String, _
ByVal uType As Long, _
ByVal cxDesired As Long, _
ByVal cyDesired As Long, _
ByVal fuLoad As Long) _
As Long
Private Declare Function apiSendMessageLong Lib "user32" _
Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
Private Declare Function apiSHGetFileInfo Lib "shell32.dll" _
Alias "SHGetFileInfoA" ( _
ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbSizeFileInfo As Long, _
ByVal uFlags As Long) _
As Long
Private Declare Function apiDestroyIcon Lib "user32" _
Alias "DestroyIcon" ( _
ByVal hIcon As Long) _
As Long
Private Declare Function apiShellNotifyIcon Lib "shell32.dll" _
Alias "Shell_NotifyIconA" ( _
ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA) _
As Long
Private Declare Function apiCallWindowProc Lib "user32" _
Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
Private Declare Function apiSetWindowLong Lib "user32" _
Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal wNewWord As Long) _
As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
' ***************************************************************
' User Defined Types
' ***************************************************************
Private Const MAX_PATH = 260
Private Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
' ***************************************************************
' Private module-level variables
' ***************************************************************
Private psfi As SHFILEINFO
Private nID As NOTIFYICONDATA
Private lpPrevWndProc As Long
Private mblnCustomIcon As Boolean
Private pHWnd As Long
Public Sub ApplicationOff()
' Set the handle of the Excel app
pHWnd = FindWindow(EXCEL_WIN_CLASS_NAME, Application.Caption)
' ' Specify icon for Systray
' Call sHookTrayIcon("My Systray application", "c:\Myapp\Myicon.ico")
' Use default icon for Systray
Call sHookTrayIcon("My Systray application")
End Sub
Private Function fWndProcTray(ByVal hwnd As Long, ByVal uMessage As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
' Callback function used to determine when the systray icon has been clicked on
' Receives messages indirectly from the operating system but allows us to
' perform additional functions for some of those messages.
On Error Resume Next
' However the shortcut is clicked re-maximise the Excel app
Select Case lParam
Case WM_LBUTTONUP: 'Left Button Up
Call apiShowWindow(hwnd, SW_SHOWMAXIMIZED)
Call sUnhookTrayIcon
Case WM_LBUTTONDBLCLK: 'Left Button Double click
Call apiShowWindow(hwnd, SW_SHOWMAXIMIZED)
Call sUnhookTrayIcon
Case WM_LBUTTONDOWN: 'Left Button down
Call apiShowWindow(hwnd, SW_SHOWMAXIMIZED)
Call sUnhookTrayIcon
Case WM_RBUTTONDBLCLK: 'Right Double-click
Call apiShowWindow(hwnd, SW_SHOWMAXIMIZED)
Call sUnhookTrayIcon
Case WM_RBUTTONDOWN: 'Right Button down
Call apiShowWindow(hwnd, SW_SHOWMAXIMIZED)
Call sUnhookTrayIcon
Case WM_RBUTTONUP: 'Right Button Up
Call apiShowWindow(hwnd, SW_SHOWMAXIMIZED)
Call sUnhookTrayIcon
End Select
' Return the messages back
fWndProcTray = apiCallWindowProc(ByVal lpPrevWndProc, ByVal hwnd, ByVal uMessage, ByVal wParam, ByVal lParam)
End Function
Private Sub sHookTrayIcon(Optional strTipText As String, Optional strIconPath As String)
' Initialize the systray icon
If fInitTrayIcon(strTipText, strIconPath) Then
Call apiShowWindow(pHWnd, SW_HIDE)
' Set new address for window's message handler
lpPrevWndProc = apiSetWindowLong(pHWnd, GWL_WNDPROC, GetAddressofFunction(AddressOf fWndProcTray))
End If
End Sub
Private Sub sUnhookTrayIcon()
' Remove the systray icon
' Restore the original message handler
Call apiSetWindowLong(pHWnd, GWL_WNDPROC, lpPrevWndProc)
' Remove the icon in the SysTray
Call apiShellNotifyIcon(NIM_DELETE, nID)
' Destroy the icon
Call apiDestroyIcon(psfi.hIcon)
End Sub
Private Function fExtractIcon() As Long
' Extracts the icon associated with Excel (an Access form)
Dim hIcon As Long
On Error GoTo ErrHandler
' Don't need the full file name as Excel files all have XLS extension.
' The SHGFI_USEFILEATTRIBUTES lets us pass an "invalid" file name to SHGetFileInfo
hIcon = apiSHGetFileInfo(".XLS", FILE_ATTRIBUTE_NORMAL, psfi, LenB(psfi), _
SHGFI_USEFILEATTRIBUTES Or SHGFI_SMALLICON Or SHGFI_ICON)
' Make sure there were no errors
If Not hIcon = 0 Then fExtractIcon = psfi.hIcon
ExitHere:
Exit Function
ErrHandler:
fExtractIcon = False
Resume ExitHere
End Function
Private Function fSetIcon(strIconPath As String) As Long
Dim hIcon As Long
' Load the 16x16 icon from file
hIcon = apiLoadImage(0&, strIconPath, IMAGE_ICON, 16&, 16&, LR_LOADFROMFILE)
If hIcon Then
' First set the form's icon
' Call apiSendMessageLong(frm.hwnd, WM_SETICON, 0&, hIcon&)
Call apiSendMessageLong(pHWnd, WM_SETICON, 0&, hIcon&)
' This will tell us afterwards if we need to reset the form's icon
mblnCustomIcon = True
' Now return the hIcon
fSetIcon = hIcon
End If
End Function
Private Function fInitTrayIcon(strTipText As String, strIconPath As String) As Boolean
Dim hIcon As Long
' If the user didn't specify the tip text, use a default value
If strTipText = vbNullString Then strTipText = "Excel"
' Load the required icon
If (strIconPath = vbNullString) Or (Dir(strIconPath) = vbNullString) Then
' If there's no icon specified, use the form's default icon
hIcon = fExtractIcon()
Else
' Load and set the icon
hIcon = fSetIcon(strIconPath)
End If
' If we were successful in previous step, then continue
' to place the icon in the system tray
If hIcon Then
With nID
.cbSize = LenB(nID)
.hwnd = pHWnd
.uID = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = hIcon
.szTip = strTipText & vbNullChar
End With
Call apiShellNotifyIcon(NIM_ADD, nID)
fInitTrayIcon = True
End If
End Function
Private Function GetAddressofFunction(Add As Long) As Long
GetAddressofFunction = Add
End Function
The next bit of code should be able to detmine whether the Excel app is minimised but I can't find an event to trigger calling the code. I reckon this is the sinle biggest obstacle to getting your functionality out - you could try a "sampling" macro which is constantly checking everysecond to see if the window is minimised and then trigger the Systray routiune but this is messy and would slow the computer down.
Code:
Option Explicit
' ShowWindow flags
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWRESTORE = 10
' FindWindow flags
Const EXCEL_WIN_CLASS_NAME = "XLMAIN"
Private Declare Function GetWindowPlacement Lib "user32" ( _
ByVal hwnd As Long, _
ByRef lpwndpl As WINDOWPLACEMENT) _
As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
Public Function IsExcelMin() As Boolean
Dim lngHWnd As Long
Dim lngRes As Long
Dim currWinP As WINDOWPLACEMENT
' Set the handle of the Excel app
lngHWnd = FindWindow(EXCEL_WIN_CLASS_NAME, Application.Caption)
' Get window state
currWinP.Length = Len(currWinP)
lngRes = GetWindowPlacement(lngHWnd, currWinP)
' See if the Window State is Minimised
If currWinP.showCmd = SW_SHOWMINIMIZED Then
IsExcelMin = True
Else
IsExcelMin = False
End If
End Function
The last problem is that Excel seems to looseits toolbars when its window state is set to SW_HIDE and then back to anyother state. I'm guessing this is because the toolbars are treated as child windows and will each need to be restored when remaximising. You could have a look at the EnumChildWindows Function to sort this out.
HTH,
Maccas
|
|
January 9th, 2006, 12:51 PM
|
|
Friend of Wrox
|
|
Join Date: Jun 2003
Posts: 173
Thanks: 0
Thanked 3 Times in 3 Posts
|
|
Ok I got a working solution - it seems to get a bit flakey when you've got the VBE window open at the same time so be warned. You'll need to create two new code modules. Firstly put the following code into the code pane of ThisWorkbook
Code:
Private Sub Workbook_Open()
Call SetUpEventTrap
End Sub
Then put this code into the first of the two new code modules
Code:
Option Explicit
' ***************************************************************
' Win API call flags
' ***************************************************************
' Unknown flags
Private Const WM_GETICON = &H7F
Private Const WM_SETICON = &H80
Private Const IMAGE_BITMAP = 0
Private Const IMAGE_ICON = 1
Private Const IMAGE_CURSOR = 2
Private Const LR_LOADFROMFILE = &H10
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
' SetWindowLongA flag
Private Const GWL_WNDPROC As Long = (-4)
' ShowWindow flags
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOW = 5
Private Const SW_SHOWRESTORE = 10
' SHGetFileInfo flags
Private Const SHGFI_ICON = &H100
Private Const SHGFI_DISPLAYNAME = &H200
Private Const SHGFI_TYPENAME = &H400
Private Const SHGFI_ATTRIBUTES = &H800
Private Const SHGFI_ICONLOCATION = &H1000
Private Const SHGFI_EXETYPE = &H2000
Private Const SHGFI_SYSICONINDEX = &H4000
Private Const SHGFI_LINKOVERLAY = &H8000
Private Const SHGFI_SELECTED = &H10000
Private Const SHGFI_ATTR_SPECIFIED = &H20000
Private Const SHGFI_LARGEICON = &H0
Private Const SHGFI_SMALLICON = &H1
Private Const SHGFI_OPENICON = &H2
Private Const SHGFI_SHELLICONSIZE = &H4
Private Const SHGFI_PIDL = &H8
Private Const SHGFI_USEFILEATTRIBUTES = &H10
' Shell_NotifyIcon Flags
Private Const NIM_ADD As Long = &H0
Private Const NIM_MODIFY As Long = &H1
Private Const NIM_DELETE As Long = &H2
' NOTIFYICONDATA flags
Private Const NIF_TIP As Long = &H4
Private Const NIF_MESSAGE As Long = &H1
Private Const NIF_ICON As Long = &H2
' Messages
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
' SHGetFileInfoA flags
Private Const FILE_ATTRIBUTE_NORMAL = &H80
' FindWindow flags
Const EXCEL_WIN_CLASS_NAME = "XLMAIN"
' ***************************************************************
' Declare Win API calls
' ***************************************************************
Private Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" ( _
ByVal hwnd As Long, _
ByVal nCmdShow As Long) _
As Long
Private Declare Function apiLoadImage Lib "user32" _
Alias "LoadImageA" ( _
ByVal hInst As Long, _
ByVal lpszName As String, _
ByVal uType As Long, _
ByVal cxDesired As Long, _
ByVal cyDesired As Long, _
ByVal fuLoad As Long) _
As Long
Private Declare Function apiSendMessageLong Lib "user32" _
Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
Private Declare Function apiSHGetFileInfo Lib "shell32.dll" _
Alias "SHGetFileInfoA" ( _
ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbSizeFileInfo As Long, _
ByVal uFlags As Long) _
As Long
Private Declare Function apiDestroyIcon Lib "user32" _
Alias "DestroyIcon" ( _
ByVal hIcon As Long) _
As Long
Private Declare Function apiShellNotifyIcon Lib "shell32.dll" _
Alias "Shell_NotifyIconA" ( _
ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA) _
As Long
Private Declare Function apiCallWindowProc Lib "user32" _
Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
Private Declare Function apiSetWindowLong Lib "user32" _
Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal wNewWord 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 SetForegroundWindow Lib "user32" ( _
ByVal hwnd As Long) _
As Long
Private Declare Function BringWindowToTop Lib "user32" ( _
ByVal hwnd As Long) _
As Long
' ***************************************************************
' User Defined Types
' ***************************************************************
Private Const MAX_PATH = 260
Private Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
' ***************************************************************
' Private module-level variables
' ***************************************************************
Private psfi As SHFILEINFO
Private nID As NOTIFYICONDATA
Private lpPrevWndProc As Long
Private mblnCustomIcon As Boolean
Private pHWnd As Long
Public Sub ApplicationOff(dummy As Byte)
' Set the handle of the Excel app
pHWnd = FindWindow(EXCEL_WIN_CLASS_NAME, Application.Caption)
' ' Specify icon for Systray
' Call sHookTrayIcon("My Systray application", "c:\Myapp\Myicon.ico")
' Use default icon for Systray
Call sHookTrayIcon("My Systray application")
End Sub
Private Function fWndProcTray(ByVal hwnd As Long, ByVal uMessage As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
' Callback function used to determine when the systray icon has been clicked on
' Receives messages indirectly from the operating system but allows us to
' perform additional functions for some of those messages.
On Error Resume Next
' However the shortcut is clicked re-maximise the Excel app
Select Case lParam
Case WM_LBUTTONUP: 'Left Button Up
Call MaxExcel(hwnd)
Case WM_LBUTTONDBLCLK: 'Left Button Double click
Call MaxExcel(hwnd)
Case WM_LBUTTONDOWN: 'Left Button down
Call MaxExcel(hwnd)
Case WM_RBUTTONDBLCLK: 'Right Double-click
Call MaxExcel(hwnd)
Case WM_RBUTTONDOWN: 'Right Button down
Call MaxExcel(hwnd)
Case WM_RBUTTONUP: 'Right Button Up
Call MaxExcel(hwnd)
End Select
' Return the messages back
fWndProcTray = apiCallWindowProc(ByVal lpPrevWndProc, ByVal hwnd, ByVal uMessage, ByVal wParam, ByVal lParam)
End Function
Private Sub sHookTrayIcon(Optional strTipText As String, Optional strIconPath As String)
' Initialize the systray icon
If fInitTrayIcon(strTipText, strIconPath) Then
Call apiShowWindow(pHWnd, SW_HIDE)
' Set new address for window's message handler
lpPrevWndProc = apiSetWindowLong(pHWnd, GWL_WNDPROC, AddressOf fWndProcTray)
End If
End Sub
Private Sub sUnhookTrayIcon()
' Remove the systray icon
' Restore the original message handler
Call apiSetWindowLong(pHWnd, GWL_WNDPROC, lpPrevWndProc)
' Remove the icon in the SysTray
Call apiShellNotifyIcon(NIM_DELETE, nID)
' Destroy the icon
Call apiDestroyIcon(psfi.hIcon)
End Sub
Private Function fExtractIcon() As Long
' Extracts the icon associated with Excel (an Access form)
Dim hIcon As Long
On Error GoTo ErrHandler
' Don't need the full file name as Excel files all have XLS extension.
' The SHGFI_USEFILEATTRIBUTES lets us pass an "invalid" file name to SHGetFileInfo
hIcon = apiSHGetFileInfo(".XLS", FILE_ATTRIBUTE_NORMAL, psfi, LenB(psfi), _
SHGFI_USEFILEATTRIBUTES Or SHGFI_SMALLICON Or SHGFI_ICON)
' Make sure there were no errors
If Not hIcon = 0 Then fExtractIcon = psfi.hIcon
ExitHere:
Exit Function
ErrHandler:
fExtractIcon = False
Resume ExitHere
End Function
Private Function fSetIcon(strIconPath As String) As Long
Dim hIcon As Long
' Load the 16x16 icon from file
hIcon = apiLoadImage(0&, strIconPath, IMAGE_ICON, 16&, 16&, LR_LOADFROMFILE)
If hIcon Then
' First set the form's icon
' Call apiSendMessageLong(frm.hwnd, WM_SETICON, 0&, hIcon&)
Call apiSendMessageLong(pHWnd, WM_SETICON, 0&, hIcon&)
' This will tell us afterwards if we need to reset the form's icon
mblnCustomIcon = True
' Now return the hIcon
fSetIcon = hIcon
End If
End Function
Private Function fInitTrayIcon(strTipText As String, strIconPath As String) As Boolean
Dim hIcon As Long
' If the user didn't specify the tip text, use a default value
If strTipText = vbNullString Then strTipText = "Excel"
' Load the required icon
If (strIconPath = vbNullString) Or (Dir(strIconPath) = vbNullString) Then
' If there's no icon specified, use the form's default icon
hIcon = fExtractIcon()
Else
' Load and set the icon
hIcon = fSetIcon(strIconPath)
End If
' If we were successful in previous step, then continue
' to place the icon in the system tray
If hIcon Then
With nID
.cbSize = LenB(nID)
.hwnd = pHWnd
.uID = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = hIcon
.szTip = strTipText & vbNullChar
End With
Call apiShellNotifyIcon(NIM_ADD, nID)
fInitTrayIcon = True
End If
End Function
Private Sub MaxExcel(lngHWnd As Long)
' Max Xl Main window
Call apiShowWindow(lngHWnd, SW_SHOW)
Call apiShowWindow(lngHWnd, SW_SHOWMAXIMIZED)
Call SetForegroundWindow(lngHWnd)
Call BringWindowToTop(lngHWnd)
' Remove the Systray icon
Call sUnhookTrayIcon
' Hook Excel back up for minimise event
Call sHook(0)
End Sub
And lastly put this code into your second new code module
Code:
' *********************************************************
' Uses ApplicationOff subroutine in modApplicationOff
' *********************************************************
Option Explicit
Private Const WM_SIZE = &H5
Private Const EXCEL_WIN_CLASS_NAME = "XLMAIN"
Public Declare Function apiCallWindowProc Lib "user32" _
Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
Public Declare Function apiSetWindowLong Lib "user32" _
Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal wNewWord As Long) _
As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
Private pHWnd As Long
Private lpPrevWndProc As Long
Private Const GWL_WNDPROC As Long = (-4)
Public Sub SetUpEventTrap()
' Set the handle of the Excel app
pHWnd = FindWindow(EXCEL_WIN_CLASS_NAME, Application.Caption)
' Hook Excel messages
Call sHook(0)
End Sub
Private Sub sExcelMessages(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Dim lngRes As Long
On Error Resume Next
' Look for WM_SIZE message
If uMsg = WM_SIZE Then
' Look for the minimise event
If wParam = 1 Then
sUnhook
Call ApplicationOff(0)
End If
End If
' Pass trapped message on to original destination
lngRes = apiCallWindowProc(ByVal lpPrevWndProc, ByVal hw, ByVal uMsg, ByVal wParam, ByVal lParam)
End Sub
Public Sub sHook(dummy As Byte)
' Trap all messages from windows and divert them to sExcelMessages
lpPrevWndProc = apiSetWindowLong(pHWnd, GWL_WNDPROC, AddressOf sExcelMessages)
End Sub
Private Sub sUnhook()
Dim lngTmp As Long
' Reset flow of windows messages
lngTmp = apiSetWindowLong(pHWnd, GWL_WNDPROC, lpPrevWndProc)
lpPrevWndProc = 0
End Sub
Like I said at the top, this code seems to work absolutely fine when not opening the VBE but because we're using WinAPI calls and subclassing the whole thing is prone to being a bit buggy so you might want to test it out beforre inflicting it on others...
Maccas
|
|
January 12th, 2006, 06:15 AM
|
|
Authorized User
|
|
Join Date: Nov 2004
Posts: 36
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
Hi Meccas,
Thanks for your attention, i tried this code, it is working but with two problems
1. execution speed is very slow
2. it is halting microsoft Excel, and sometimes Excel show me famous
message that Some due to some unknown error Excel will be closed and resumed and i should send this report to microsoft. this happens
most of the time when i add my personal code to a new module and try to access this code...
so if you also faced such errors and suppose found a solution for them, can you please help me out to how to cop the situation...
Tayyab
|
|
January 12th, 2006, 06:56 AM
|
|
Friend of Wrox
|
|
Join Date: Jun 2003
Posts: 173
Thanks: 0
Thanked 3 Times in 3 Posts
|
|
Tayyab,
Since putting the code together I've tried it out again and experience the same sorts of problems as you in that Excel just crashes or freezes all the time making this code unworkable.
The reason for this is that the method we use to try and capture the Excel being minimised event. AFAIK, there is no way to trap the Application being minimised event (which is what you wanted to kick off the send to Systray subroutine) other than to hack into windows and to subclass the whole application. Subclassing is C++ / VB technique whereby you intercept every message Windows (the OS) sends to something, in this case the Excel application, do something if a certain message is being sent and then pass the message onto its original destination. The problem is that Windows sends Excel a lot of messages and VBA isn't quick enough to process them so the system quickly goes into meltdown.
The good news is that, at least on my system, the ApplicationOff subroutine (which sends Excel to the Systray & is all of the code put into the first module) seems to work pretty well. I think that this then leaves you with two or three options:
1) Don't try to trap the Excel being minimised event at all but rather have a new button somewhere which will send Excel to the Systray and leave the Excel minimised functionality in tact. You could then choose whether you wanted to minimise Excel or Systray Excel. This has its advantages as other users may not be expecting the Excel tab to disappear from the taskbar in the way that it should if you got the code working.
2) If you really must trap the Excel being minimised event you'll have to write code in VB / C. You'll have to use the same sort of idea as was being attempted here with subclassing and I'd recommend you expose an object model which would raise an Excel being resized event off the back of trapping the relevant messages. This could then be referenced in your VBA code (in much the same way that you might reference the Word object model) and you could then write a separate class module to trap the events being raised from your new object model. All this is a lot of work and I can't really help you with how to transpose the posted code into the other languages as I've only ever really used VBA but I think it should work.
3) If the above principle does apply there is a chance that someone will have already written some sort of Excel add-in which you can buy / dwnlad from somewhere. You should have a look around on the internet for likely candidates.
Sorry I can't be of more use,
Maccas
|
|
January 16th, 2006, 06:30 AM
|
|
Registered User
|
|
Join Date: Jan 2006
Posts: 3
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
|
|
January 16th, 2006, 04:17 PM
|
|
Authorized User
|
|
Join Date: Nov 2004
Posts: 36
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
Dear Meccas,
Thanks for your kind help....
your tip for visual basic is correct.. and i m basically a visual basic developer.........i have done the task but bascially it i have used visual basic that calls microsoft Excel objects through automation.... but finally goal has been achieved...
but thanks for your kind responses...
Tayyab
|
|
|
