AW: Excel-Leiste
15.01.2012 23:59:05
Tom
Hallo Sepp,
danke erstmal für Deine Mühe. Aber hier tut sich gar nichts ... Was mache ich falsch?
Habe den kompletten Code in ein neues Modul (Allgemein) kopiert und folgendes geändert:
'Hier gewünschten Fenstertitel angeben!
Application.Caption = "Tom - privat"
ActiveWindow.Caption = ""
End Sub
Wie bekomme ich die Grafik als ico-Datei ?
Danke
TOM
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal ClassName As String, ByVal _
WindowName As String) As Long
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal Instance As Long, ByVal _
ExeFileName As String, ByVal IconIndex As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Message _
As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Const WM_SETICON = &H80
Private Sub ResetExcelIcon()
Dim hWnd As Long
Dim hIcon As Long
hWnd = FindWindow("XLMAIN", Application.Caption)
hIcon = ExtractIcon(0, Application.Path & "\excel.exe", 0)
If hIcon > 1 Then
Call SendMessage(hWnd, WM_SETICON, True, hIcon)
Call SendMessage(hWnd, WM_SETICON, False, hIcon)
End If
End Sub
Private Sub SetExcelIcon(ByVal IconPath As String)
Dim hWnd As Long
Dim hIcon As Long
hWnd = FindWindow("XLMAIN", Application.Caption)
hIcon = ExtractIcon(0, IconPath, 0)
If hIcon > 1 Then
Call SendMessage(hWnd, WM_SETICON, True, hIcon)
Call SendMessage(hWnd, WM_SETICON, False, hIcon)
End If
End Sub
Public Sub changeIconAndCaption()
Application.Caption = "XXXEXCELXXX"
'Die Icon-Datei muss im Verzeichnis der Arbeitsmappe liegen!
Call SetExcelIcon(ThisWorkbook.Path + "\myIcon.ico")
'Hier gewünschten Fenstertitel angeben!
Application.Caption = "Tom - privat"
ActiveWindow.Caption = ""
End Sub
Public Sub resetIconAndCaption()
Application.Caption = "XXXEXCELXXX"
Call ResetExcelIcon
Application.Caption = ""
ActiveWindow.Caption = ActiveWorkbook.Name
End Sub