Старый ответ без ответа: пользовательский значок Excel потерян с несколькими книгами

Question

Я могу использовать следующий код, чтобы установить пользовательский значок для приложения Excel. Это изменит значок окна и значок, отображаемый на панели задач Windows:

Public Const strIcon As String = "%SystemRoot%\system32\SHELL32.dll" ' Icon file
Public Const IconIndex As Long = 137

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal ClassName As String, ByVal WindowName As String) As Long
Public Declare Function SendMessageA Lib "user32" (ByVal HWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Public Declare Function ExtractIconA Lib "shell32.dll" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Public Const ICON_SMALL As Long = 0&
Public Const ICON_BIG As Long = 1&
Public Const WM_SETICON As Long = &H80



Sub SetupIcon()
    SetIcon strIcon, IconIndex
End Sub

Sub SetIcon(FileName As String, Optional index As Long = 0)
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' SetIcon
    ' This procedure sets the icon in the upper left corner of
    ' the main Excel window. FileName is the name of the file
    ' containing the icon. It may be an .ico file, an .exe file,
    ' or a .dll file. If it is an .ico file, Index must be 0
    ' or omitted. If it is an .exe or .dll file, Index is the
    ' 0-based index to the icon resource.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    #If VBA7 And Win64 Then
        ' 64 bit Excel
        Dim HWnd As LongPtr
        Dim HIcon As LongPtr
    #Else
        ' 32 bit Excel
        Dim HWnd As Long
        Dim HIcon As Long
    #End If
    Dim n As Long
    Dim s As String
    If Dir(FileName, vbNormal) = vbNullString Then
        ' file not found, get out
        Exit Sub
    End If
    ' get the extension of the file.
    n = InStrRev(FileName, ".")
    s = LCase(Mid(FileName, n + 1))
    ' ensure we have a valid file type
    Select Case s
        Case "exe", "ico", "dll"
            ' OK
        Case Else
            ' invalid file type
            Err.Raise 5
    End Select
    HWnd = Application.HWnd
    If HWnd = 0 Then
        Exit Sub
    End If
    HIcon = ExtractIconA(0, FileName, index)
    If HIcon <> 0 Then
        SendMessageA HWnd, WM_SETICON, ICON_SMALL, HIcon
    End If
End Sub

Однако я замечаю, что при добавлении новой книги в приложение пользовательский значок теряется (по крайней мере, на панели задач) - и он возвращается к значку Excel по умолчанию.

При поиске решения в Интернете я нашел похожий вопрос, заданный в SO: изменение значка Excel не работает при открытии другой книги

Естественно, я бы не стал публиковать новый вопрос, который является точной копией существующего вопроса. Однако (связанное) решение этого связанного вопроса не было предложено. Я также отмечаю, что вопрос был опубликован в 2012 году, и поэтому весьма вероятно, что с тех пор наше сообщество выросло в экспертных знаниях и опыте. Они могут быть кем-то здесь сейчас, кто знает, как решить это, но просто не видел вопрос. Я надеюсь, что сообщество простит повторяющийся вопрос (думайте, что он ударил старый).

Кто-нибудь сможет предложить решение этой проблемы? Мои знания API почти нулевые. Благодарю.

Answer 1

При запуске Excel он использует значок приложения ,

Он использует его до тех пор, пока вы не создадите какую-либо книгу, кроме той, которая была изначально создана в Excel. Затем он взрывает рабочие книги на панели задач, и вы получаете две кнопки с иконками рабочей книги. ,

Даже если вы закроете вторую рабочую книгу, в первой по-прежнему будет использоваться значок рабочей книги. Когда вы закроете все книги, он вернется к значку приложения (вы можете проверить его, позвонив SetupIcon и закрытие всех рабочих книг), но после создания любой рабочей книги он снова переключается на значок рабочей книги.

Вы должны попытаться перечислить все окна книги и изменить значки также для них.

Я не уверен, что это можно сделать непосредственно в VBA, но вы могли бы использовать функции winapi FindWindowEx, EnumChildWindows, GetWindow,

Главное окно Excel имеет имя класса XLMAIN, Это содержит XLDESK который содержит рабочие тетради (EXCEL7) и другие дети. использование Spy++ проверить иерархию.

Такое поведение, вероятно, зависит от настроек панели задач и доступного пространства. Если панель задач не взрывается, на кнопках будет отображаться значок приложения.

---

Проверено и, к сожалению, это не работает. Он изменяет значки окон рабочей книги (когда они не развернуты), но значки на панели задач остаются прежними.

---

Это работает, но немного хакерски. Я использую жестко закодированное имя класса MS-SDIb, Это деталь реализации Excel 2007 и может не работать в других версиях.

'Doesn't work for me
'Public Const strIcon As String = "%SystemRoot%\system32\SHELL32.dll" ' Icon file
Public Const strIcon As String = "C:\Windows\system32\SHELL32.dll" ' Icon file

Public Const IconIndex As Long = 137

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal ClassName As String, ByVal WindowName As String) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClassName As String, ByVal lpszCaption As String) As Long
' For 64 bit may need replacing with SetClassLongPtr
Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Const GCL_HICON As Long = -14
Const GCL_HICONSM As Long = -34
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

Public Declare Function SendMessageA Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Public Declare Function ExtractIconA Lib "shell32.dll" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Public Const ICON_SMALL As Long = 0&
Public Const ICON_BIG As Long = 1&
Public Const WM_SETICON As Long = &H80


Sub SetupIcon()
    SetIcon strIcon, IconIndex
End Sub

Sub SetIcon(FileName As String, Optional index As Long = 0)
    #If VBA7 And Win64 Then
        ' 64 bit Excel
        Dim hwnd As LongPtr
        Dim DeskHWnd As LongPtr
        Dim Workbook As LongPtr
        Dim HIcon As LongPtr
    #Else
        ' 32 bit Excel
        Dim hwnd As Long
        Dim DeskHWnd As Long
        Dim Workbook As Long
        Dim HIcon As Long
    #End If
    Dim ThreadId As Long
    Dim n As Long
    Dim s As String
    If Dir(FileName, vbNormal) = vbNullString Then
        ' file not found, get out
        Exit Sub
    End If
    ' get the extension of the file.
    n = InStrRev(FileName, ".")
    s = LCase(Mid(FileName, n + 1))
    ' ensure we have a valid file type
    Select Case s
        Case "exe", "ico", "dll"
            ' OK
        Case Else
            ' invalid file type
            Err.Raise 5
    End Select
    hwnd = Application.hwnd
    If hwnd = 0 Then
        Exit Sub
    End If
    ThreadId = GetWindowThreadProcessId(hwnd, ByVal 0&)
    DeskHWnd = FindWindowEx(hwnd, 0, "XLDESK", vbNullString)
    If DeskHWnd = 0 Then
        Exit Sub
    End If

    HIcon = ExtractIconA(0, FileName, index)
    If HIcon = 0 Then
        Exit Sub
    End If

    SendMessageA hwnd, WM_SETICON, ICON_SMALL, HIcon
    SendMessageA hwnd, WM_SETICON, ICON_BIG, HIcon
    ' For 64 bit may need replacing with SetClassLongPtr
    SetClassLong hwnd, GCL_HICON, HIcon
    SetClassLong hwnd, GCL_HICONSM, HIcon

    WorkbookHWnd = FindWindowEx(DeskHWnd, 0, "EXCEL7", vbNullString)
    Do While WorkbookHWnd <> 0
        SendMessageA WorkbookHWnd, WM_SETICON, ICON_SMALL, HIcon
        SendMessageA WorkbookHWnd, WM_SETICON, ICON_BIG, HIcon

        WorkbookHWnd = FindWindowEx(DeskHWnd, WorkbookHWnd, "EXCEL7", vbNullString)
    Loop
    SetClassLong WorkbookHWnd, GCL_HICON, HIcon
    SetClassLong WorkbookHWnd, GCL_HICONSM, HIcon

    WorkbookHWnd = FindWindowEx(0, 0, "MS-SDIb", vbNullString)
    Do While WorkbookHWnd <> 0
        ' Check if WorkbookHWnd was created by same thread as Application.hwnd
        If ThreadId = GetWindowThreadProcessId(WorkbookHWnd, ByVal 0&) Then
            SendMessageA WorkbookHWnd, WM_SETICON, ICON_SMALL, HIcon
            SendMessageA WorkbookHWnd, WM_SETICON, ICON_BIG, HIcon
            SetClassLong WorkbookHWnd, GCL_HICON, HIcon
            SetClassLong WorkbookHWnd, GCL_HICONSM, HIcon
        End If

        WorkbookHWnd = FindWindowEx(0, WorkbookHWnd, "MS-SDIb", vbNullString)
    Loop
End Sub

Работает даже для новых книг благодаря изменению иконки класса с SetClassLong,

Ошибка: каждый значок утечки вызова возвращается ExtractIconA,