As you all know you can easy change the "Microsoft Excel" text in the
caption bar by the VBA command "Application.caption = "My Excel""...
But how do you change the Excel Icon in the upper left corner of the
application window? And also in the activewindow?
If you can do it in Visual Basic or in Visual Basic for Application,
please let me know...
Thanxxx,
Robsan
(you can me mail also at rob...@freegates.be)
Here is a function that does what you want. It is based on an example
published in John Green's best-selling and must-have book "Excel 2000
VBA - Programmer's reference"; i think that the particular example is
authored by Stephen Bullen.
I have developed the function a little further to allow setting of the
icons of idividual workbooks and build-in capability to reset the
original icon of Excel.
Put the following function into a standard module.
At the end of the listing there are four sub-routines that demostrate
how to use it.
HTH
Stratos
---------------------------------------------------------------------------------------------------------
Option Explicit
'-----------------------------------------------------------------
'Win32 API Function Declarations
'-----------------------------------------------------------------
Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" _
( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) _
As Long
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
Declare Function ExtractIcon _
Lib "shell32.dll" _
Alias "ExtractIconA" _
( _
ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long _
) _
As Long
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
'-----------------------------------------------------------------
'Win32 API Constant Declarations
'-----------------------------------------------------------------
Const WM_SETICON As Long = &H80
'-----------------------------------------------------------------
'Custom function for changing Excel's windows icons
'-----------------------------------------------------------------
Public Function fncSetXLWindowIcon _
( _
Optional IconFile As String = vbNullString, _
Optional WorkbookName As String = vbNullString _
) _
As Boolean
'-----------------------------------------------------------------
'Variable Declarations
'-----------------------------------------------------------------
Dim XLMAINhWnd As Long, XLDESKhWnd As Long, _
EXCEL7hWnd As Long, TargetWindowhWnd As Long, _
VirtualIcon As Long
'initialise the result of the function to false; assume failure
fncSetXLWindowIcon = True
'-----------------------------------------------------------------
'STEP 1. Identify the target window
'-----------------------------------------------------------------
'get the caption from the first window of the specified workbook; if
any
On Error Resume Next
If CBool(Len((Workbooks(WorkbookName).Name))) Then
WorkbookName = Workbooks(WorkbookName).Windows(1).Caption
End If
On Error GoTo ExitFunction
'if a caption has been extracted get a hendle to that workbook window;
'else get a handle to Excel's main window
If Not WorkbookName = vbNullString Then
XLMAINhWnd = FindWindow("XLMAIN", Application.Caption)
XLDESKhWnd = FindWindowEx(XLMAINhWnd, 0, "XLDESK", vbNullString)
TargetWindowhWnd = FindWindowEx(XLDESKhWnd, 0, "EXCEL7",
WorkbookName)
Else
XLMAINhWnd = FindWindow("XLMAIN", Application.Caption)
TargetWindowhWnd = XLMAINhWnd
End If
'if we couldn't get a handle, exit the function
If TargetWindowhWnd = 0 Then Exit Function
'-----------------------------------------------------------------
'STEP 2. Extract the icon from the respective file
'-----------------------------------------------------------------
If IconFile = vbNullString Then
'assume that the user asked to restore the original icon
VirtualIcon = 0
Else
'try to extract the icon from the specified file
VirtualIcon = ExtractIcon(0, IconFile, 0)
'If the file could not be found (1), or if the no icon could be
'found in the file (0), exit the function
If VirtualIcon <= 1 Then Exit Function
End If
'-----------------------------------------------------------------
'STEP 3. Send a Windows message to the specified window to change
' its icon
'-----------------------------------------------------------------
'in most cases only the second (False) message is adequate
SendMessage TargetWindowhWnd, WM_SETICON, True, VirtualIcon
SendMessage TargetWindowhWnd, WM_SETICON, False, VirtualIcon
'
'the functio has been completed succesfully
fncSetXLWindowIcon = True
ExitFunction:
End Function
Sub test1_fncSetXLWindowIcon()
'set XL's main window icon
fncSetXLWindowIcon "dos01.ico"
End Sub
Sub test2_fncSetXLWindowIcon()
'restore XL's main window icon
fncSetXLWindowIcon
End Sub
Sub test3_fncSetXLWindowIcon()
'set active workbook's window icon
fncSetXLWindowIcon "dos01.ico", ActiveWorkbook.Name
End Sub
Sub test4_fncSetXLWindowIcon()
'restore active workbook's window icon
fncSetXLWindowIcon , ActiveWorkbook.Name
End Sub
---------------------------------------------------------------------------------------------------------
The big application icon always changes without any problem (tested with
office 97 / 2000 and win 9x/nt).
But the activeworkbook icon doesn't change (except in normal view (not
maximized)) until after 2 times you've minimez/maximize the view. And it
changes only in excel 2000, not in excel 97...
But, now I have some code to start from, perhaps I'll find that little
problem or a way to work around.
Once again, thanks a lot,
Robsan
In article <398C1C0A...@csv.warwick.ac.uk>, ie...@csv.warwick.ac.uk
says...
> Hi Robsan,
>
> Here is a function that does what you want. It is based on an example
> published in John Green's best-selling and must-have book "Excel 2000
> VBA - Programmer's reference"; i think that the particular example is
> authored by Stephen Bullen.
>
> I have developed the function a little further to allow setting of the
> icons of idividual workbooks and build-in capability to reset the
> original icon of Excel.
>
> Put the following function into a standard module.
> At the end of the listing there are four sub-routines that demostrate
> how to use it.
>
>
> HTH
> Stratos
<snip>
Actually, if you know how to use it, it works evrey time in Excel 97
as well (I don't have 2K). I'm sure that now that you know where to
start from, you'll manage to get it working for you as well.
As I said it changes the icon for the main Excel Window or an
individual Workbook window; the icon that you see in the maximized view
under Excel's window icon is not a menu icon but a separate control
(you can actually click it or right-click it) This can change as well
but this is another story; of course, now you know where to start from,
I'm sure you'll to find a workaround.
Please let us know of your findings.
Regards,
Stratos
robsan wrote:
>
> Thank you very much,
> It works...sometimes.
>
> The big application icon always changes without any problem (tested with
> office 97 / 2000 and win 9x/nt).
>
> But the activeworkbook icon doesn't change (except in normal view (not
> maximized)) until after 2 times you've minimez/maximize the view. And it
> changes only in excel 2000, not in excel 97...
>
> But, now I have some code to start from, perhaps I'll find that little
> problem or a way to work around.
>
> Once again, thanks a lot,
>
> Robsan
>
> In article <398C1C0A...@csv.warwick.ac.uk>, ie...@csv.warwick.ac.uk
> says...
> > Hi Robsan,
> >
> > Here is a function that does what you want. It is based on an example
> > published in John Green's best-selling and must-have book "Excel 2000
> > VBA - Programmer's reference"; i think that the particular example is
> > authored by Stephen Bullen.
> >
> > I have developed the function a little further to allow setting of the
> > icons of idividual workbooks and build-in capability to reset the
> > original icon of Excel.
> >
> > Put the following function into a standard module.
> > At the end of the listing there are four sub-routines that demostrate
> > how to use it.
> >
> >
> > HTH
> > Stratos
> <snip>