| |
以前、どこかで見つけたコードです。
あらかじめmyIcon.icoをブックと同じフォルダに用意して下さい。
'エクセル・アイコンの変更。(API)
Declare Function DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare Function GetActiveWindow Lib "user32" () As Long
Public Const WM_SETICON = &H80
Public Const ICON_SMALL = 0&
Public Const ICON_BIG = 1&
'エクセル・アイコンの変更。
Sub Set_xlIcon()
Dim hWnd As Long
'エクセル・ハンドル 取得。
hWnd = FindWindow("XLMAIN", Application.Caption)
If hWnd = 0 Then Exit Sub
SetIcon hWnd, ThisWorkbook.Path & Application.PathSeparator & "myIcon.ico"
End Sub
'hWnd：Window handle
'strIconName：Name of Icon (*.ico)
Sub SetIcon(hWnd As Long, strIconName As String)
Dim lngIcon As Long
lngIcon = ExtractIcon(0, strIconName, 0)
If lngIcon <> 0 Then
Call SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal lngIcon)
Call SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal lngIcon)
DrawMenuBar hWnd
End If
End Sub
'エクセル・アイコンのリセット。
Sub Reset_xlIcon()
Dim hWnd As Long
'エクセル・ハンドル 取得。
hWnd = FindWindow("XLMAIN", Application.Caption)
ResetIcon hWnd
End Sub
Sub ResetIcon(hWnd As Long)
Call SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal 0&)
Call SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal 0&)
DrawMenuBar hWnd
End Sub
|
|
- 04/2/5(木) 8:17 -
