AW: Excel Symbol / Name
16.04.2006 22:37:54
chris
Hallo das könntest du mit diesem Code erreichen.
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
Dim filetoopen
Private Const WM_SETICON As Long = &H80
Private Const GC_CLASSNAMEMSEXCEL = "XLMAIN"
Private Const GC_CLASSNAMEMSEXCELWND = "XLDESK"
Private Const GC_CLASSNAMEMSEXCELTABLE = "EXCEL7"
Private Sub prcSetXLWindowIcon(Optional ByVal IconFile As String, Optional WorkbookName As String)
Dim XLMAINhWnd As Long, XLDESKhWnd As Long
Dim TargetWindowhWnd As Long, VirtualIcon As Long
XLMAINhWnd = FindWindow(GC_CLASSNAMEMSEXCEL, Application.Caption)
If Not WorkbookName = vbNullString Then
XLDESKhWnd = FindWindowEx(XLMAINhWnd, 0&, _
GC_CLASSNAMEMSEXCELWND, vbNullString)
TargetWindowhWnd = FindWindowEx(XLDESKhWnd, 0&, _
GC_CLASSNAMEMSEXCELTABLE, WorkbookName)
Else
TargetWindowhWnd = XLMAINhWnd
End If
If TargetWindowhWnd <> 0 Then
If IconFile = vbNullString Then
VirtualIcon = 0
Else
VirtualIcon = ExtractIcon(0, IconFile, 0)
If VirtualIcon <= 1 Then VirtualIcon = 0
End If
SendMessage TargetWindowhWnd, WM_SETICON, False, VirtualIcon
SendMessage TargetWindowhWnd, WM_SETICON, True, VirtualIcon
End If
End Sub
Public Sub prcReset()
Application.Caption = Empty
ActiveWindow.Caption = ActiveWorkbook.Name
prcSetXLWindowIcon
prcSetXLWindowIcon , ThisWorkbook.Name
End Sub
Public Sub prcSet()
filetoopen = Application.GetOpenFilename("Text Files (*.*), *.*", , "Icon file auswählen *.ico")
Call prcSetXLWindowIcon(filetoopen)
Call prcSetXLWindowIcon(filetoopen, ActiveWorkbook.Name)
Application.Caption = "Meine Anwendung"
ActiveWindow.Caption = "Chris"
End Sub
Rückmeldung wäre nett gruß Chris