Icon statt Excel-Icon im Fenster
05.01.2006 18:11:58
Vliegen
Habe bei einer Recherche hier bei Herber verschiedene Codes gefunden um oben links ein eigenes Icon in das Anwendungsfenster zu setzen statt des Icons von Excel. Habe mir eine .ico Datei geschaffen und diese auf den unten beschriebeen Pfade gelegt und wie im Beispiel benannt ("DeinIcon.ico").
Hab die Sache sowohl mit dem hier unten stehenden Code aus auch mit einer Variante von Herbers-Tipps versucht. Irgendwie bin ich offensichtlich zu blöd. Jedenfalls prangt dort immer noch das Excel-X und grinst mit an.
Verstehe ich da was falsch ?
Hat jemand da Erfahrung und die Geduld es mir zu erläutern ?
Gruss aus Belgien,
François
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
Const WM_SETICON As Long = &H80
Public
Function fncSetXLWindowIcon(Optional IconFile As String = vbNullString, _
Optional WorkbookName As String = vbNullString) As Boolean
Dim XLMAINhWnd As Long, XLDESKhWnd As Long, _
EXCEL7hWnd As Long, TargetWindowhWnd As Long, _
VirtualIcon As Long
fncSetXLWindowIcon = True
On Error Resume Next
If CBool(Len((Workbooks(WorkbookName).Name))) Then
WorkbookName = Workbooks(WorkbookName).Windows(1).Caption
End If
On Error GoTo ExitFunction
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 TargetWindowhWnd = 0 Then Exit Function
If IconFile = vbNullString Then
VirtualIcon = 0
Else
VirtualIcon = ExtractIcon(0, IconFile, 0)
If VirtualIcon <= 1 Then Exit Function
End If
SendMessage TargetWindowhWnd, WM_SETICON, True, VirtualIcon
SendMessage TargetWindowhWnd, WM_SETICON, False, VirtualIcon
fncSetXLWindowIcon = True
ExitFunction:
End Function
Sub FensterSymbolÄndern_fncSetXLWindowIcon()
'Fenstericon setzen
fncSetXLWindowIcon ("C:\DeinIcon.ico") '<-- Anpassen!!
End Sub
Sub FensterSymbolOriginal_fncSetXLWindowIcon()
'Fenstericon löschen
fncSetXLWindowIcon
End Sub