未答复的旧 post：Excel 自定义图标因多个工作簿而丢失
Unanswered old post: Excel custom icon lost with multiple workbooks
我可以使用以下代码为 Excel 应用程序设置自定义图标。这将更改 window 的图标，以及 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 上发现了一个类似的问题：
Changing Excel Icon doesn't work when another workbook is opened
自然地，我通常不会 post 一个与现有问题完全相同的新问题。但是，没有为该链接问题提供（现成的）解决方案。我还注意到这个问题是 post 于 2012 年提出的，因此很有可能从那时起我们的社区在专业知识和经验方面有所增长。他们现在很可能是这里的人，知道如何解决它，但根本没有看到问题。我希望社区能够原谅重复的问题（将其视为与旧问题相撞）。
有人能提供解决方案吗？我的 API 知识几乎为零。谢谢
当您启动时 Excel 它使用一个应用程序图标 。
它会使用它，直到您在最初由 Excel 创建的工作簿旁边创建任何工作簿。然后它会在任务栏上展开工作簿，您会看到两个带有工作簿图标的按钮 。
即使您关闭第二个工作簿，第一个工作簿仍使用工作簿图标。
当您关闭所有工作簿时，它将恢复为应用程序图标（您可以通过调用 SetupIcon 并关闭所有工作簿来检查），但在创建任何工作簿后，它将切换回工作簿图标。
您应该尝试枚举所有工作簿 windows 并更改它们的图标。
我不确定这是否可以直接在 VBA 中完成，但您可以使用 winapi 函数 FindWindowEx、EnumChildWindows、GetWindow.
主要 Excel window 有 class 名称 XLMAIN。它包含 XLDESK，其中包含工作簿 (EXCEL7) 和其他子项。使用 Spy++ 检查层次结构。
此行为可能取决于任务栏设置和可用 space。如果任务栏不分解按钮，它将显示应用程序图标。
检查了一下，不幸的是它不起作用。它更改工作簿的图标 windows（未最大化时），但任务栏上的图标保持不变。
这可行，但有点老套。我正在使用硬编码 class 名称 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
由于将 class 图标更改为 SetClassLong，甚至适用于新工作簿。
BUG：每次调用都会泄漏 ExtractIconA 返回的图标。
我可以使用以下代码为 Excel 应用程序设置自定义图标。这将更改 window 的图标，以及 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 上发现了一个类似的问题： Changing Excel Icon doesn't work when another workbook is opened
自然地，我通常不会 post 一个与现有问题完全相同的新问题。但是，没有为该链接问题提供（现成的）解决方案。我还注意到这个问题是 post 于 2012 年提出的，因此很有可能从那时起我们的社区在专业知识和经验方面有所增长。他们现在很可能是这里的人，知道如何解决它，但根本没有看到问题。我希望社区能够原谅重复的问题（将其视为与旧问题相撞）。
有人能提供解决方案吗？我的 API 知识几乎为零。谢谢
当您启动时 Excel 它使用一个应用程序图标
它会使用它，直到您在最初由 Excel 创建的工作簿旁边创建任何工作簿。然后它会在任务栏上展开工作簿，您会看到两个带有工作簿图标的按钮
即使您关闭第二个工作簿，第一个工作簿仍使用工作簿图标。
当您关闭所有工作簿时，它将恢复为应用程序图标（您可以通过调用 SetupIcon 并关闭所有工作簿来检查），但在创建任何工作簿后，它将切换回工作簿图标。
您应该尝试枚举所有工作簿 windows 并更改它们的图标。
我不确定这是否可以直接在 VBA 中完成，但您可以使用 winapi 函数 FindWindowEx、EnumChildWindows、GetWindow.
主要 Excel window 有 class 名称 XLMAIN。它包含 XLDESK，其中包含工作簿 (EXCEL7) 和其他子项。使用 Spy++ 检查层次结构。
此行为可能取决于任务栏设置和可用 space。如果任务栏不分解按钮，它将显示应用程序图标。
检查了一下，不幸的是它不起作用。它更改工作簿的图标 windows（未最大化时），但任务栏上的图标保持不变。
这可行，但有点老套。我正在使用硬编码 class 名称 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
由于将 class 图标更改为 SetClassLong，甚至适用于新工作簿。
BUG：每次调用都会泄漏 ExtractIconA 返回的图标。