VB and VBA Users Source Code: Setting/altering Excel's window icons
[
Home
|
Contents
|
Search
|
Reply
| Previous |
Next
]
VB/VBA Source Code
Setting/altering Excel's window icons
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, February 01, 2002
Hits:
1279
Category:
Office
Article:
The following code demonstrates how to change Excel's window icons. Option Explicit '--------------SET ICON API------------- Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 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 FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long 'Purpose : Sets Excel's icons to a specific icon file. 'Inputs : lHwndExcel The handle to Excel ' sIconPath The path to the new icon 'Outputs : Returns False on success, True on error. 'Author : Andrew Baker 'Date : 31/Jan/2002 'Notes : 'Revisions : Function ExcelSetIcon(lHwndExcel As Long, sIconPath As String) As Boolean Dim lResult As Long, lHwdIcon As Long, lHwndDesktop As Long, lhwndXLDesk As Long Const WM_GETICON = &H7F, WM_SETICON = &H80, ICON_BIG = 1 On Error GoTo ErrFailed 'Extract Icon lHwdIcon = ExtractIcon(0, sIconPath, 0) If lHwdIcon > 1 Then '-------Set Excel's Icon lResult = SendMessage(lHwndExcel, WM_SETICON, False, lHwdIcon) '-------Set Desktop Icon (workbook icon) 'From the Excel Window, get the Excel desktop lhwndXLDesk = FindWindowEx(lHwndExcel, 0, "XLDESK", vbNullString) 'From the Excel desktop, get the workbook window. lHwndDesktop = FindWindowEx(lhwndXLDesk, 0, "EXCEL7", vbNullString) lResult = SendMessage(lHwndDesktop, WM_SETICON, False, lHwdIcon) 'Refresh the workbook icon ActiveWorkbook.Windows(1).WindowState = xlMinimized ActiveWorkbook.Windows(1).WindowState = xlMaximized '-------Set ALT+TAB Icon SendMessage lHwndExcel, WM_SETICON, ICON_BIG, ByVal lHwdIcon ExcelSetIcon = False End If Exit Function ErrFailed: Debug.Print "Error in ExcelSetIcon: " & Err.Description ExcelSetIcon = True End Function 'Demonstration routine to set Excel's icons Sub Test() Dim lHwnd As Long lHwnd = FindWindow("XLMAIN", Application.Caption) If ExcelSetIcon(lHwnd, "c:\test.ico") Then MsgBox "Changed Excel's icon..." End If End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
