Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Const WM_SETICON = &H80
Dim msIconPath As String
Dim WState As Integer
Sub changIcon() '修改工作表窗口图标
'选择一个含有图标的文件,如exe,dll,ico等
Dim fdlg As FileDialog
Set fdlg = Application.FileDialog(msoFileDialogFilePicker)
With fdlg
.AllowMultiSelect = False
.Filters.Add "可执行文件", "*.exe"
.Filters.Add "dll文件", "*.dll"
.Filters.Add "图标文件", "*.ico"
.Filters.Add "所有文件", "*.*"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "请选择一个文件"
Exit Sub
End If
msIconPath = .SelectedItems(1)
End With
Dim wbHwnd, XLhwnd As Long, hLng As Long
Dim hIcon
XLhwnd = Application.hWnd 'Excel程序窗口的句柄
wbHwnd = FindWindowEx(XLhwnd, 0&, "XLDESK", vbNullString) '工作区的句柄
wbHwnd = FindWindowEx(wbHwnd, 0&, vbNullString, vbNullString) '第一个工作簿窗口的句柄
hIcon = ExtractIcon(0, msIconPath, 0)
If hIcon = 0 Then
MsgBox "文件不包含图标"
Exit Sub
End If
WState = ThisWorkbook.Windows(1).WindowState
ThisWorkbook.Windows(1).WindowState = xlNormal '把窗口还原,这样更快显示图标的变化
SendMessage wbHwnd, WM_SETICON, True, hIcon '改变图标
SendMessage wbHwnd, WM_SETICON, False, hIcon
ThisWorkbook.Windows(1).WindowState = WState '恢复窗口原来的状态
End Sub
Sub DefaultIcon()
WState = ThisWorkbook.Windows(1).WindowState
ThisWorkbook.Windows(1).WindowState = xlNormal
XLhwnd = Application.hWnd
wbHwnd = FindWindowEx(XLhwnd, 0&, "XLDESK", vbNullString)
wbHwnd = FindWindowEx(wbHwnd, 0&, vbNullString, vbNullString)
SendMessage wbHwnd, WM_SETICON, True, 0
SendMessage wbHwnd, WM_SETICON, False, 0
ThisWorkbook.Windows(1).WindowState = WState
End Sub |
