Changing The Window Icon
This page describes code to change the icon of the main Excel window's icon.
When you are building a custom application in Excel, you can personalize it by replacing
the default icon for the main Excel window with your own custom icon. You can use an
ico file containing a single icon or an exe or
dll file that may contain any number of icons. The code uses the
Windows API functions ExtractIcon to get the icon from a file and
SendMessage to send a message to the window instructing it to
change its icon.
The definition of the procedure is:
Sub SetIcon(FileName As String, Optional Index As Long = 0)
Here, FileName is the name of the file containing the icon, and
Index is the 0-based location of the desired icon. If you use an
ico icon file, Index must be 0, since an
ico icon file can contain only one icon. If you use an exe file
or dll file, Index indicates which icon
to retrieve from the file. Many icon editors such as MicroAngelo Toolset (which I highly recommend) allow you to
view and extract icons stored in any exe or dll file. Visual Studio 2010
also has some of these tools.
The code for the SetIcon function is shown below. The conditional compilation directives
(#if, #else) allow you to use this code in either 32-bit or 64-bit
versions of Excel.
#If VBA7 And Win64 Then
Private Declare PtrSafe Function SendMessageA Lib "user32" _
(ByVal HWnd As LongPtr, _
ByVal wMsg As LongPtr, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function ExtractIconA Lib "shell32.dll" _
(ByVal hInst As LongPtr, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As LongPtr) As Long
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
Private Const WM_SETICON = &H80
#Else
Private Declare Function SendMessageA Lib "user32" _
(ByVal HWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Integer, _
ByVal lParam As Long) As Long
Private Declare Function ExtractIconA Lib "shell32.dll" _
(ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Private Const ICON_SMALL As Long = 0&
Private Const ICON_BIG As Long = 1&
Private Const WM_SETICON As Long = &H80
#End If
Sub SetIcon(FileName As String, Optional Index As Long = 0)
#If VBA7 And Win64 Then
Dim HWnd As LongPtr
Dim HIcon As LongPtr
#Else
Dim HWnd As Long
Dim HIcon As Long
#End If
Dim N As Long
Dim S As String
If Dir(FileName, vbNormal) = vbNullString Then
Exit Sub
End If
N = InStrRev(FileName, ".")
S = LCase(Mid(FileName, N + 1))
Select Case S
Case "exe", "ico", "dll"
' OK
Case Else
' invalid file type
Err.Raise 5
End Select
HWnd = Application.HWnd
If HWnd = 0 Then
Exit Sub
End If
HIcon = ExtractIconA(0, FileName, Index)
If HIcon <> 0 Then
SendMessageA HWnd, WM_SETICON, ICON_SMALL, HIcon
End If
End Sub
You can call this procedure with code like the following:
SetIcon "C:\Test\Chip.ico", 0
To reset the icon back to the default Excel icon, use code like
Dim FName As String
FName = Application.Path & "\excel.exe"
SetIcon FileName:=FName, Index:=0
|
This page last updated: 2-May-2012. |