Mappen Icon Wechsel geht nicht wirklich
31.10.2007 14:39:18
Louis
wende mich mit folgendem Problem an euch.
Ich ändere den Applications Icon und den Mappen Icon folgendem Code. Das funktioniert auch solange, bis ich die "IconwechselMappe", nach einer schon offenen, öffne.
Also:
Iconwechselmappe öffnen - Mappe1 öffnen : Kein Problem, Icon wechselt hin und her bei Mappenwechsel. Auch das Icon in der Taskleiste.
Mappe1 öffnen - Iconwechselmappe öffnen : Fenster Icon wechselt zwar aber nicht das in der Taskleiste
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.dll" 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.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Const WM_SETICON As Long = &H80
Private Sub prcSetXLWindowIcon(Optional IconFile As String, _
Optional WorkbookName As String)
Dim XLMAINhWnd As Long, XLDESKhWnd As Long
Dim TargetWindowhWnd As Long, VirtualIcon As Long
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
If IconFile = vbNullString Then
VirtualIcon = 0
Else
VirtualIcon = ExtractIcon(0, IconFile, 0)
If VirtualIcon
Public Sub prcReset()
Application.Caption = Empty
ActiveWindow.Caption = ThisWorkbook.Name
prcSetXLWindowIcon
prcSetXLWindowIcon , ActiveWorkbook.Name
End Sub
Public Sub prcSet()
Application.Caption = "contact"
ActiveWindow.Caption = "MängelFilter Stations Inspektionen"
Call prcSetXLWindowIcon _
("C:\contact\MängelFilter Stations Inspektionen\Symbole\ToolIcon.ico")
Call prcSetXLWindowIcon _
("C:\contact\MängelFilter Stations Inspektionen\Symbole\ToolIcon.ico" _
, ActiveWorkbook.Name)
End Sub
Private Sub Workbook_Activate()
'Leisten False
Call prcSet
End Sub
Private Sub Workbook_Deactivate()
' Leisten True
Call prcReset
End Sub
Ich hoffe ich konnte das Problem einigermaßen erklären!
Mann ist praktisch gezwungen alle offnen ExcelAnwendungen erst einmal zu schliessen.
Danke für eure Mühe schon einmal im vorraus.
mfg
Louis