现在的位置: 首页 > 窗体增强 > 正文

VBA 窗体之添加窗体图标

2014年05月28日 窗体增强 ⁄ 共 1945字 ⁄ 字号 暂无评论 ⁄ 阅读 2,058 次

注意: 本文适用于 Excel 2000 及其以后版本(包含 64 位 Office )

VBA 的窗体其实就是一个 Dialog(对话框窗体),缺少完整窗体的许多元素,窗体标题栏上的图标就是其中之一, 有时我们自己需要美化一下它,使用代码来为它添加窗体图标(如图)。

001

附件下载:

点击链接从百度网盘下载

操作如下:

  • 在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

给我留言

您必须 [ 登录 ] 才能发表留言!