--
Regards
Martijn Evers AKA Dm Unseen
'Mark Lundberg said
'Here's some code that will change the XL icon both
'for the Excel system menu (top left corner), and in
'the taskbar. I can't remember where I got the code
'from, but I think it was Stephen Bullen's. Seems likely,
'anyway <g>.
'Get the handle for a window
Declare Function wapiFindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Extract an icon from a file
Declare Function wapiExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
'Send a Windows message
Declare Function wapiSendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, _
ByVal lparam As Long) As Long
'Windows message types
Public Const WM_SETICON = &H80
Sub changeicon()
Dim sName As String
sName = "C:\Test\example.ico"
'Uncomment the next line to restore the standard Excel icon.
'sName = "C:\Program Files\Microsoft Office97\Office\msoffice.exe"
Call procSetIcon(sName)
End Sub
Sub procSetIcon(sIconPath)
Dim a As Long, ihWnd As Long, ihIcon As Long
'Get the handle of the Excel window
ihWnd = wapiFindWindow("XLMAIN", Application.Caption)
'Get the icon from the source
ihIcon = wapiExtractIcon(0, sIconPath, 0)
'1 means invalid icon source, 0 means no icons in source
If ihIcon > 1 Then
'Set the big (32x32) and small (16x16) icons
a = wapiSendMessage(ihWnd, WM_SETICON, True, ihIcon)
a = wapiSendMessage(ihWnd, WM_SETICON, False, ihIcon)
End If
End Sub
If it was a Stephen's site, you can go there with
http://www.BMSLtd.co.uk then go to the Excel or other Excel related page.
Regards,
Tom Ogilvy
"Martijn Evers" <mwe...@ingr.com> wrote in message
news:ehbM5.6142$By5.3...@news-east.usenetserver.com...
CODE:
Option Explicit
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA"
(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As
Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal
lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal
lpClassName As String, ByVal lpWindowName As String) As Long
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0
Private Const ICON_BIG = 1
Sub setExcelIcon(Optional strFileName As String = "", Optional strIconIndex
As Long = 0, Optional bSetBigIcon As Boolean = False, Optional bSetSmallIcon
As Boolean = True)
Dim hIcon As Long
Dim hwndXLApp As Long
On Error Resume Next
hwndXLApp = FindWindow("XLMAIN", Application.Caption) 'XL97
If hwndXLApp <> 0 Then
Err.Clear
If strFileName = "" Then
strIconIndex = 5000 ' setting a very large number so it will
reset
'setting the icon back should also work
'hIcon = ExtractIcon(0, Application.Path &
Application.PathSeparator & "Excel.exe", strIconIndex)
ElseIf Dir(strFileName) = "" Then
hIcon = 0
ElseIf Err.Number <> 0 Then
hIcon = 0
Else
'Get the icon from the source
hIcon = ExtractIcon(0, strFileName, strIconIndex)
End If
'Set the big (32x32) and small (16x16) icons
If bSetBigIcon Then SendMessage hwndXLApp, WM_SETICON, ICON_BIG,
hIcon
If bSetSmallIcon Then SendMessage hwndXLApp, WM_SETICON, ICON_SMALL,
hIcon
End If
End Sub
Thanks !
the only real difference i found are the ICON_BIG and SMALL constants I use.
The only problem i find is that this algorithm replaces on my computer (NT
4 sp6 IE 5.5) both the taskbar/window icon and ALT-TAB icon with the same
icon(the 32x32 icon) , when i select an icon out of an icon library, or icon
file . I circumvented this by creating 2 icons(large and small) and being
able to specify which type of icon to update(large or small), but i still
don't understand why it doesn't work correctly(i.e it doesn't update the
window/taskbar icon with the 16/16 icon).
Note the standard excel icon is in Excel.exe , icon 0, although specifying
an illegal index also resets the excel icon
--
Regards
Martijn Evers AKA Dm Unseen
"Tom Ogilvy" <Thomas....@hqda.army.mil> wrote in message
news:u9horBNRAHA.289@cppssbbsa04...