VBA的窗體其實就是一個Dialog(對話框窗體)，缺少完整窗體的許多元素，窗體標題欄上的圖標就是其中之一，有時我們自己需要美化一下它，使用代碼來為它添加窗體圖標(如圖)。

附件下載：

點擊鏈接從百度網盤下載

操作如下：

?在Excel的VBE窗口中插入一個用戶窗體，將其命名為frmIcon。然后再添加一個模塊。在窗體和模塊中添加后面所列代碼。

?在工作薄中的任意工作表中添加一窗體按鈕控件，將指定其設置宏為btnShowfrmIcon_Click。其供示范之用。

具體代碼：

"mdIcon"模塊代碼

?

Sub btnShowfrmIcon_Click()
frmIcon.Show
End Sub

"frmIcon" 窗體代碼

Option Explicit
'以下聲明API函數
#If Win64 Then '64位
'查找窗口
Private Declare PtrSafe Function FindWindow _
Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As LongPtr
'視情況向窗體發送不同的消息
Private Declare PtrSafe Function SendMessage _
Lib "user32" _
Alias "SendMessageA" ( _
ByVal hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
lParam As Any) _
As LongPtr
'重繪窗體菜單欄
Private Declare PtrSafe Function DrawMenuBar _
Lib "user32" ( _
ByVal hwnd As LongPtr) _
As Long
'從文件等中提取圖標
Private Declare PtrSafe Function ExtractIcon _
Lib "shell32.dll" _
Alias "ExtractIconA" ( _
ByVal hInst As LongPtr, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) _
As LongPtr
#Else
'查找窗口
Private Declare Function FindWindow _
Lib "User32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
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 DrawMenuBar _
Lib "User32" ( _
ByVal Hwnd 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
#End If
#If Win64 Then '64位
Private FHwnd As LongPtr
Private FHIcon As LongPtr
#Else
Private FHwnd As Long
Private FHIcon As Long
#End If
'以下聲明常數
Private Const WM_SETICON = &H80

'********************************
'------------主程序--------------
'********************************
Private Sub UserForm_Initialize()
'取得本窗體句柄
FHwnd = FindWindow("ThunderDFrame", Me.Caption)
'從Excel 中提取圖標
FHIcon = ExtractIcon(0, Application.Path & "\EXCEL.EXE", 0)
'向窗體發送消息
SendMessage FHwnd, WM_SETICON, False, FHIcon
'重繪窗體標題欄
DrawMenuBar FHwnd
End Sub