Egna ikoner för MS Excel
Här demonstreras ett sätt att ersätta de inbyggda ikonerna i MS Excel med egna ikoner. Lösningen bygger på Windows API.För att skapa egna ikoner för genvägar på skrivbordet se Skapa genväg till arbetsbok och mapp
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 stFileName As String = "", Optional strIconIndex _
As Long = 0, Optional bSetBigIcon As Boolean = False, Optional bSetSmallIcon _
As Boolean = True)
'© 2002 Alla rättigheter Stephen Bullen
Dim hIcon As Long
Dim hwndXLApp As Long
On Error Resume Next
hwndXLApp = FindWindow("XLMAIN", Application.Caption)
If hwndXLApp <> 0 Then
Err.Clear
If stFileName = "" Then
strIconIndex = 8000
hIcon = ExtractIcon(0, Application.Path & Application.PathSeparator & "Excel.exe", strIconIndex)
ElseIf Dir(stFileName) = "" Then
hIcon = 0
ElseIf Err.Number <> 0 Then
hIcon = 0
Else
hIcon = ExtractIcon(0, stFileName, strIconIndex)
End If
'XL-Dennis bidrag i lösningen: Ändra ikon i aktivitetsfältet.
If bSetBigIcon Then SendMessage hwndXLApp, WM_SETICON, ICON_BIG, hIcon
'Ändra ikon i MS Excel.
If bSetSmallIcon Then SendMessage hwndXLApp, WM_SETICON, ICON_SMALL, hIcon
End If
End Sub
Sub Byt_Ikoner()
setExcelIcon "E:\OfficeIkoner\staroffice.ico"
End Sub
Sub Aterstalla_Ikoner()
setExcelIcon ""
End Sub