[原创]WORD中建立工具栏下拉菜单及右键方法

andysky

WORD提供了录制宏的强大功能，使大家很多工作可以一键完成，但录制的宏都将产生很多冗余代码，而且部分功能是无法录制的，故微软提供了编辑宏的支持（VBA）

在WORD中用VBA新建菜单或者工具是很简单的，现提供一个自制下拉工具菜单，并附说明，望初学者能举一反三（三楼为自制右键菜单，百叶窗动画时钟,六楼为右键弹出式菜单;八楼为欢迎画面设计）。

先看看效果。

注意：开启前请将宏之安全性设为低，关闭日历窗体请用ALT+F4（代码在二楼,）：

Yw3ItojI.rar (183.17 KB, 下载次数: 845)

2006-12-13 17:32 上传

点击文件名下载附件
[原创]WORD中建立工具栏下拉菜单方法

andysky

---

模块中代码

Option Explicit
Sub autoopen() '自动宏，开启WORD时执行
On Error Resume Next   '当错误时执行下一步
   Application.CommandBars(1).Controls("我的菜单(&M)").Delete  '如果已有菜单则删除
    Dim Menu As CommandBarControl, SubMenu As CommandBarControl '申明变量
    '设定变量类型----下拉菜单，其中1表示本菜单出现在"常用"栏
    Set Menu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
    With Menu    'with语句可以提高代码可读性及执行效率
        .Caption = "我的菜单(&M)"  '新菜单的名字，可以随便定义
    End With     '结束with
    With Menu.Controls.Add(msoControlButton, 1, , , True) '添加子菜单
        .Caption = "日历"                                 '子菜单标题
        .OnAction = "日历宏"                              '子菜单宏名
        .FaceId = 481                                     '子菜单图标
    End With
    With Menu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "时钟"
        .OnAction = "时钟宏"
         .FaceId = 484
    End With
    With Menu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "说明"
        .OnAction = "说明"
        .FaceId = 176
        .BeginGroup = True
    End With
    End Sub
Sub 日历宏()      '子菜单之宏代码
精美日历.Show 0   '以无模式显示日历窗体
End Sub
Sub 时钟宏()
时钟.Show 0        '以无模式显示时钟标题
End Sub
Sub 说明()
   说明窗体.Show   '显示說明标题
   End Sub
Sub DeleteMenu()   '删除新菜单，此处可以不要，前面已有。但为了大家学习置于此处。
Application.CommandBars(1).Controls("我的菜单(&M)").Delete
End Sub

---

窗体中代码：

Private Sub UserForm_Initialize()
Me.Height = 205                  '窗体高度
Me.Width = 237                   '窗体宽度
Me.ShockwaveFlash1.Width = 237   'flash高度
Me.ShockwaveFlash1.Width = 237   'falsh宽度
End Sub

Private Sub UserForm_Initialize()
Me.ShockwaveFlash1.Width = 396    'flash宽度
Me.ShockwaveFlash1.Height = 51    'flash高度
End Sub

Option Explicit
Private Declare Function DrawMenuBar Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const GWL_STYLE As Long = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_EX_DLGMODALFRAME = &H1&
Private Sub UserForm_Initialize()
    Dim IStyle As Long, Hwnd As Long
    '******获取窗口句柄******
    If Val(Application.Version) < 9 Then
        Hwnd = FindWindow("ThunderXFrame", Me.Caption)
    Else
        Hwnd = FindWindow("ThunderDFrame", Me.Caption)
    End If
    '******去除窗体标题栏******
    IStyle = GetWindowLong(Hwnd, GWL_STYLE)
    IStyle = IStyle And Not WS_CAPTION
    SetWindowLong Hwnd, GWL_STYLE, IStyle
    DrawMenuBar Hwnd
    '******去除窗体四周的边框******
'    IStyle = GetWindowLong(Hwnd, GWL_EXSTYLE) And Not WS_EX_DLGMODALFRAME
'    SetWindowLong Hwnd, GWL_EXSTYLE, IStyle

With Me.ShockwaveFlash1
.Width = 351       'flash宽度
.Height = 264      'flash高度
.Left = -6         'flash左边距
.Top = -6          'flash上边距
End With
Me.Height = 255    '窗体高度
Me.Width = 345     '窗体宽度
End Sub

andysky

再献一个自制右键菜单之法

本例以右键弹出时钟为例说明添加新菜单之法（本例中右键时钟以百叶窗动画显示，双击关闭）

CLiB6gce.rar (40.83 KB, 下载次数: 324)

2006-12-13 19:26 上传

点击文件名下载附件
[原创]WORD中建立工具栏下拉菜单方法

[此贴子已经被作者于2006-12-14 18:03:39编辑过]

办公之星

真是赏心悦目，限于年龄、时间和精力，不能学习这些复杂的内容了。

强力支持楼主的开发和创作。

tangqingfu

的确是赏心悦目，andysky兄的功力真是非同凡响！

andysky

再教一招制作右键弹出式菜单（外带一个文字动画。）

8bXYvFni.rar (12.05 KB, 下载次数: 270)

2006-12-14 18:00 上传

点击文件名下载附件
[原创]WORD中建立工具栏下拉菜单及右键方法

luo159

經典，收藏了。

總有一天我也要達到此水準！

andysky

再给一个标准的欢印LOGO Jdg6KT0Q.rar (105.35 KB, 下载次数: 242)

2006-12-15 16:22 上传

点击文件名下载附件
[原创]WORD中建立工具栏下拉菜单及右键方法

daley

QUOTE:

以下是引用andysky在2006-12-15 16:22:49的发言：
再给一个标准的欢印LOGO

怎么会是个空文档？？？

poetbox

QUOTE:

以下是引用daley在2006-12-17 17:51:53的发言：

怎么会是个空文档？？？

no,a beautiful girl appears and disappears.