VBA的窗体其实就是一个Dialog(对话框窗体),缺少完整窗体的许多元素,窗体标题栏上的图标就是其中之一,有时我们自己需要美化一下它,使用代码来为它添加窗体图标(如图)。
附件下载:
点击链接从百度网盘下载
操作如下:
◾在Excel的VBE窗口中插入一个用户窗体,将其命名为frmIcon。然后再添加一个模块。在窗体和模块中添加后面所列代码。
◾在工作薄中的任意工作表中添加一窗体按钮控件,将指定其设置宏为btnShowfrmIcon_Click。其供示范之用。
具体代码:
"mdIcon"模块代码
文章内容由强国说-WPS之家(wps.qiangguoshuo.com)收集于网络,希望能为广大朋友提供帮助。
Sub btnShowfrmIcon_Click()frmIcon.ShowEnd 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 LongPtrPrivate FHIcon As LongPtr#ElsePrivate FHwnd As LongPrivate 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 FHwndEnd Sub
转载声明:本站发布文章及版权归原作者所有,转载本站文章请注明文章来源!