EXCEL VBA ActiveX 按钮不可用

linkedin_24719509 2014-12-22 04:53:54
大家好,
我在一份EXCEL表格中添加了一个ActiveX的控件按钮,之前运行正常的,但是忽然有一天所有的ActiveX按钮都点不动了,就是说点了没反应,当然程序也不能运行。
这份EXCEL表格在其他电脑上运行正常的。
在这台电脑上重新新建一个表格,当尝试插入ActiveX的按钮的时候,会报错,因为这台电脑已经不在手里,具体什么错误已经记不清了,大概是 ....object...
我曾经尝试重新注册那个组件,也是无效的。
大家有谁有相关类似经验吗?
谢谢
...全文
5429 1 打赏 收藏 转发到动态 举报
写回复
用AI写文章
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
  • 打赏
  • 举报
回复
如果你是2010版本以上的话,需要确认选项-信任中心-信任中心设置-Activex 设置中是否禁用了控件。 因为这个设置是用于所有office应用程序的,所以你无论在哪个程序中设置了,都将不能使用控件。
完整清晰版 PDF ,有目录。共 270MB,分为 2 个分卷 中文版Excel 2007 高级VBA编程 宝典 OFFICE2007 中文版Excel 2007高级VBA编程宝典 原价:99.99元 作者:(美)沃肯巴赫(Walkenbach,J) 著;冯飞,焦瑜净 译 出版社:清华大学出版社 出版日期:2009-2-1 ISBN:9787302194675 字数:1294000 页码:872 编辑推荐 -------------------------------------------------------------------------------- “电子表格先生”潜心力作,世界级Excel畅销书。   “千锤百炼”的Excel畅销书    没有人比“电子表格先生”更了解Excel 2007。本书涵盖了使用VBA 扩展Excel 功能的方法、提示和思想。Excel 2007 还有一些绝秘的新技巧,John Walkenbach 将帮助您掌握它们。 本书的作者John Walkenbach 是享有国际美誉的“电子表格先生”。他在书中分享了自己15 年来使用Excel 的经验,毫无保留地传授了学习和使用Excel 的所有知识,为读者掌握Excel 提供了绝佳的途径。本书的前两个版本均已获得巨大成功,在前两版的基础上,本书升华了已有的精华,并结合Excel 2007 的全新特性,是一部技术含量高、实践性强的经典著作。 本书将介绍如何定制Excel 用户窗体、开发新实用程序、用VBA 处理图表及数据透视表,以及创建事件处理应用程序。还将介绍如何使用VBA 子过程和函数过程、与其他应用程序轻松交互、构建用户友好的工具栏、菜单和帮助系统等。 内容提要 -------------------------------------------------------------------------------- 这本全能的手册适合对Excel感兴趣的所有人群,不但内容丰富、权威,且条理清晰、结构合理。本书的作者是当之无愧的世界级Excel电子表格专家,他为读者倾心打造了这本专著,书中汇聚他15年来使用Excel的所有经验,涵盖Excel应用和VBA编程涉及的方方面面,是经典著作Excel 2003 Power Programming with VBA的全新升级版。 目录 -------------------------------------------------------------------------------- 第Ⅰ部分 Excel基础知识  第1章 Excel 2007的起源   1.1 电子表格软件的简史    1.1.1 最初的起源:VisiCalc    1.1.2 Lotus 1-2-3     1.1.3 Quattro Pro   1.1.4 Microsoft Excel   1.2 Excel 对开发人员的重要性   1.3 Excel在Microsoft 战略中的角色  第2章 Excel概述   2.1 关于对象   2.2 工作簿    2.2.1 工作表    2.2.2 图表工作表    2.2.3 XLM宏工作表    2.2.4 Excel 5/95对话框编辑表   2.3 Excel的用户界面    2.3.1 功能区的引入    2.3.2 快捷菜单    2.3.3 对话框    2.3.4 键盘快捷键    2.3.5 智能标记    2.3.6 任务窗格   2.4 自定义屏幕显示   2.5 数据录入   2.6 公式、函数和名称   2.7 选择对象   2.8 格式    2.8.1 数字格式    2.8.2 样式格式   2.9 保护选项    2.9.1 保护公式以防被重写    2.9.2 保护工作簿的结构    2.9.3 运用密码来保护工作簿    2.9.4 使用密码来保护VBA代码   2.10 图表   2.11 形状和SmartArt   2.12 数据库访问    2.12.1 工作表数据库    2.12.2 外部数据库   2.13 Internet特性   2.14 分析工具    2.14.1 分级显示    2.14.2 分析工具库    2.14.3 数据透视表    2.14.4 Solver    2.14.5 XML特性   2.15 加载项   2.16 宏和编程   2.17 文件格式   2.18 Excel的帮助系统  第3章 公式的使用技巧   3.1 公式概述   3.2 计算公式   3.3 单元格和单元格区域引用    3.3.1 为什么使用不是相对的引用    3.3.2 R1C1表示法    3.3.3 引用其他的工作表或工作簿   3.4 使用名称    3.4.1 命名单元格和单元格区域    3.4.2 将名称应用于现有的引用    3.4.3 交叉名称    3.4.4 命名列和行    3.4.5 名称的作用范围    3.4.6 命名常量    3.4.7 命名公式    3.4.8 命名对象   3.5 公式错误   3.6 数组公式    3.6.1 一个数组公式的例子    3.6.2 数组公式日历    3.6.3 数组公式的优缺点   3.7 计数和求和技巧    3.7.1 计数公式的示例    3.7.2 求和公式的示例    3.7.3 其他计数工具   3.8 使用日期和时间    3.8.1 输入日期和时间    3.8.2 使用1900年之前的日期   3.9 创建大公式  第4章 理解Excel的文件   4.1 启动Excel   4.2 文件类型    4.2.1 Excel文件格式    4.2.2 文本文件格式    4.2.3 数据库文件格式    4.2.4 其他文件格式   4.3 模板文件的处理    4.3.1 查看模板    4.3.2 创建模板    4.3.3 创建工作簿模板   4.4 Excel文件的内部情况    4.4.1 仔细分析一个文件    4.4.2 为什么文件格式很重要   4.5 QAT文件   4.6 XLB文件   4.7 加载宏文件   4.8 Excel在注册表中的设置    4.8.1 关于注册表    4.8.2 Excel的设置 第Ⅱ部分 Excel应用程序开发  第5章 电子表格应用程序的内涵   5.1 电子表格应用程序   5.2 开发人员和终端用户    5.2.1 谁是开发人员    5.2.2 电子表格应用程序用户的分类    5.2.3 电子表格应用程序的客户   5.3 用Excel解决问题   5.4 基本的电子表格应用程序类型    5.4.1 快捷但质量不高的电子表格应用程序    5.4.2 自己创作、自己使用的电子表格应用程序    5.4.3 单用户电子表格应用程序    5.4.4 意大利面条式电子表格应用程序    5.4.5 实用电子表格应用程序    5.4.6 包含工作表函数的加载宏电子表格    5.4.7 单元块预算式电子表格应用程序    5.4.8 假设分析模型式电子表格应用程序    5.4.9 数据存储和访问电子表格应用程序    5.4.10 数据库前端电子表格应用程序    5.4.11 统包式电子表格应用程序  第6章 电子表格应用程序开发的基础   6.1 确定用户需求   6.2 规划满足用户需求的应用程序   6.3 确定最合适的用户界面    6.3.1 创建自定义的功能区    6.3.2 创建自定义的快捷菜单    6.3.3 创建快捷键    6.3.4 创建自定义的对话框    6.3.5 在工作表上使用ActiveX控件    6.3.6 执行开发的成果   6.4 使自己关心终端用户    6.4.1 测试应用程序    6.4.2 尽量完善应用程序的安全性    6.4.3 让应用程序变得美观和直观    6.4.4 创建用户帮助系统    6.4.5 将开发工作进行归档    6.4.6 将电子表格应用程序分发给用户    6.4.7 在需要的时候更新电子表格应用程序   6.5 其他开发问题    6.5.1 用户安装的Excel版本    6.5.2 语言问题    6.5.3 系统速度    6.5.4 视频模式 第Ⅲ部分 理解VBA  第7章 VBA概述   7.1 BASIC的一些基本背景   7.2 关于VBA    7.2.1 对象模型    7.2.2 VBA与XLM的对比   7.3 VBA的基础知识   7.4 Visual Basic编辑器概述    7.4.1 显示Excel的“开发工具”选项卡    7.4.2 激活VBE    7.4.3 VBE窗口   7.5 使用“工程资源管理器”窗口    7.5.1 添加新的VBA模块    7.5.2 移除VBA模块    7.5.3 导出和导入对象   7.6 使用“代码”窗口    7.6.1 窗口的最小化和最大化    7.6.2 VBA代码的存储    7.6.3 VBA代码的输入   7.7 VBE环境的定制    7.7.1 使用“编辑器”选项卡    7.7.2 使用“编辑器格式”选项卡    7.7.3 使用“通用”选项卡    7.7.4 使用“可连接的”选项卡   7.8 宏录制器    7.8.1 宏录制器实际记录哪些内容    7.8.2 相对模式还是绝对模式    7.8.3 选项的录制    7.8.4 整理己录制的宏   7.9 关于对象和集合    7.9.1 对象层次结构    7.9.2 关于集合    7.9.3 对象的引用   7.10 属性和方法    7.10.1 对象的属性    7.10.2 对象的方法   7.11 Comment对象示例    7.11.1 查看有关Comment对象的帮助    7.11.2 Comment对象的属性    7.11.3 Comment对象的方法    7.11.4 Comments集合    7.11.5 关于Comment属性    7.11.6 Comment对象中的对象    7.11.7 确定单元格中是否含有Comment对象    7.11.8 添加新的Comment对象   7.12 一些有用的应用程序属性   7.13 Range对象的使用    7.13.1 Range属性    7.13.2 Cells属性    7.13.3 Offset属性   7.14 关于对象的更多信息    7.14.1 需要牢记的基本概念    7.14.2 学习有关对象和属性的更多信息  第8章 VBA编程基础   8.1 VBA语言元素概览   8.2 注释   8.3 变量、数据类型和常量    8.3.1 数据类型的定义    8.3.2 声明变量    8.3.3 变量的作用域    8.3.4 常量的使用    8.3.5 字符串的使用    8.3.6 日期的使用   8.4 赋值语句   8.5 数组    8.5.1 数组的声明    8.5.2 多维数组的声明    8.5.3 动态数组的声明   8.6 对象变量   8.7 用户定义数据类型   8.8 内置函数   8.9 对象和集合的处理    8.9.1 With-End With构造    8.9.2 For Each-Next构造   8.10 代码执行的控制    8.10.1 GoTo语句    8.10.2 If-Then构造    8.10.3 Select Case构造    8.10.4 指令的循环块  第9章 VBA的Sub过程   9.1 关于过程    9.1.1 Sub过程的声明    9.1.2 过程的作用域   9.2 执行Sub过程    9.2.1 通过“运行子过程/用户窗体”命令执行过程    9.2.2 从“宏”对话框执行过程    9.2.3 用Ctrl 快捷键组合执行过程    9.2.4 从功能区执行过程    9.2.5 从自定义快捷菜单中执行过程    9.2.6 从另一个过程执行过程    9.2.7 通过单击对象执行过程    9.2.8 在事件发生时执行过程    9.2.9 从“立即窗口”执行过程   9.3 向过程中传递参数   9.4 错误处理技术    9.4.1 捕获错误    9.4.2 错误处理示例   9.5 使用Sub过程的实际例子    9.5.1 目标    9.5.2 工程需求    9.5.3 已经了解的信息    9.5.4 着手处理    9.5.5 需要了解哪些信息    9.5.6 初步的录制工作    9.5.7 初始设置    9.5.8 代码的编写    9.5.9 排序过程的编写    9.5.10 更多的测试    9.5.11 修复问题    9.5.12 实用程序的可用性    9.5.13 对工程进行评估  第10章 创建Function过程   10.1 Sub过程与Function过程的对比   10.2 为什么创建自定义的函数   10.3 介绍性的函数示例    10.3.1 一个自定义函数    10.3.2 在工作表中使用函数    10.3.3 在VBA过程中使用函数    10.3.4 分析自定义函数   10.4 Function过程    10.4.1 声明函数    10.4.2 函数的作用域    10.4.3 执行Function过程   10.5 Function过程的参数   10.6 函数示例    10.6.1 无参数的函数    10.6.2 带有一个参数的函数    10.6.3 带有两个参数的函数    10.6.4 使用数组作为参数的函数    10.6.5 带有可选参数的函数    10.6.6 返回VBA数组的函数    10.6.7 返回错误值的函数    10.6.8 带有不定数量的参数的函数   10.7 模拟Excel的SUM函数   10.8 函数的调试   10.9 使用“插入函数”对话框    10.9.1 指定函数类别    10.9.2 添加函数说明   10.10 使用加载宏存储自定义的函数   10.11 使用Windows API    10.11.1 Windows API示例    10.11.2 确定Windows目录    10.11.3 检测Shift键    10.11.4 了解更多有关API 函数的信息  第11章 VBA编程示例和技巧   11.1 处理单元格区域    11.1.1 复制单元格区域    11.1.2 移动单元格区域    11.1.3 复制大小可变的单元格区域    11.1.4 选中或者识别各种类型的单元格区域    11.1.5 提示输入单元格中的值    11.1.6 在下一个空单元格中输入一个值    11.1.7 暂停宏的运行以便获得用户选中的单元格区域    11.1.8 计算选中的单元格的数目    11.1.9 确定选中的单元格区域的类型    11.1.10 有效地遍历选中的单元格区域    11.1.11 删除所有空行    11.1.12 任意次数地复制行    11.1.13 确定单元格区域是否包含在另一个单元格区域内    11.1.14 确定单元格的数据类型    11.1.15 读写单元格区域    11.1.16 在单元格区域中插入值的更好方法    11.1.17 传递一维数组中的内容    11.1.18 将单元格区域传递给Variant类型的数组    11.1.19 按数值选择单元格    11.1.20 复制非连续的单元格区域   11.2 处理工作簿和工作表    11.2.1 保存所有工作簿    11.2.2 保存和关闭所有工作簿    11.2.3 隐藏除选区之外的区域    11.2.4 同步工作表   11.3 VBA技巧    11.3.1 切换布尔类型的属性值    11.3.2 确定打印页面的数量    11.3.3 显示日期和时间    11.3.4 获得字体列表    11.3.5 对数组进行排序    11.3.6 处理一系列文件   11.4 使用在代码中的一些有用的函数    11.4.1 FileExists函数    11.4.2 FileNameOnly函数    11.4.3 PathExists函数    11.4.4 RangeNameExists函数    11.4.5 SheetExists函数    11.4.6 WorkbookIsOpen函数    11.4.7 检索已经关闭的工作簿中的值   11.5 一些有用的工作表函数    11.5.1 返回单元格的格式信息    11.5.2 会说话的工作表    11.5.3 显示在保存或打印文件时的时间    11.5.4 理解对象的父亲    11.5.5 计算值介于两个值之间的单元格数目    11.5.6 计算单元格区域中可见单元格的数目    11.5.7 确定行或列中最后一个非空的单元格    11.5.8 字符串与模式匹配    11.5.9 从字符串中提取第n个元素    11.5.10 多功能的函数    11.5.11 SheetOffset函数    11.5.12 返回所有工作表中数据的最大值    11.5.13 返回没有重复的随机整数元素的数组    11.5.14 随机化单元格区域   11.6 Windows API调用    11.6.1 确定文件的关联性    11.6.2 确定磁盘驱动器信息    11.6.3 确定默认打印机的信息    11.6.4 确定视频显示器的信息    11.6.5 为应用程序添加声音    11.6.6 读写注册表 第Ⅳ部分 用户窗体  第12章 多种自定义对话框的方法   12.1 创建用户窗体之前需要了解的内容   12.2 使用输入框    12.2.1 VBA的InputBox函数的使用    12.2.2 Excel的InputBox方法   12.3 VBA的MsgBox函数   12.4 Excel的GetOpenFilename方法   12.5 Excel的GetSaveAsFilename方法   12.6 提示输入目录名称    12.6.1 使用Windows API函数选中目录    12.6.2 使用FileDialog对象选中目录   12.7 显示Excel的内置对话框    12.7.1 关于Dialogs集合    12.7.2 执行功能区命令   12.8 显示数据记录单    12.8.1 使得数据记录单变得可以访问    12.8.2 通过使用VBA来显示数据记录单  第13章 用户窗体概述   13.1 Excel如何处理自定义对话框   13.2 插入新的用户窗体   13.3 向用户窗体添加控件   13.4 “工具箱”中的控件    13.4.1 复选框    13.4.2 组合框    13.4.3 命令按钮    13.4.4 框架    13.4.5 图像    13.4.6 标签    13.4.7 列表框    13.4.8 多页    13.4.9 选项按钮    13.4.10 RefEdit    13.4.11 滚动条    13.4.12 数值调节钮    13.4.13 TabStrip    13.4.14 文本框    13.4.15 切换按钮   13.5 调整用户窗体的控件   13.6 调整控件的属性    13.6.1 使用“属性”窗口    13.6.2 共同属性    13.6.3 更多属性的信息    13.6.4 适应键盘用户的需求   13.7 显示和关闭用户窗体    13.7.1 显示用户窗体    13.7.2 关闭用户窗体    13.7.3 关于事件处理程序   13.8 创建用户窗体的示例    13.8.1 创建用户窗体    13.8.2 编写代码显示对话框    13.8.3 测试对话框    13.8.4 添加事件处理程序    13.8.5 验证数据的有效性    13.8.6 完成的对话框作品   13.9 理解用户窗体的事件    13.9.1 了解事件    13.9.2 用户窗体的事件    13.9.3 数值调节钮的事件    13.9.4 数值调节钮与文本框配对   13.10 引用用户窗体的控件   13.11 自定义“工具箱”    13.11.1 更改图标或提供文本    13.11.2 添加新页    13.11.3 自定义或组合控件    13.11.4 添加新的ActiveX控件   13.12 创建用户窗体的模板   13.13 用户窗体检验表  第14章 用户窗体示例  第15章 用户窗体的高级技巧 第Ⅴ部分 高级编程技巧  第16章 用VBA开发Excel实用程序  第17章 使用数据透视表  第18章 使用图表  第19章 理解Excel的事件  第20章 与其他应用程序的交互  第21章 创建和使用加载宏 第Ⅵ部分 开发应用程序  第22章 使用功能区  第23章 使用快捷菜单  第24章 为应用程序提供帮助  第25章 开发面向用户的应用程序 第Ⅶ部分 其他主题  第26章 兼容性问题  第27章 用VBA处理文件  第28章 使用Visual Basic组件  第29章 理解类模块  第30章 使用颜色  第31章 有关Excel编程的常见问题 第Ⅷ部分 附录
仪表图形 ActiveX 扩展控件包提供另外一组可用在图形用户界面应用上的 ActiveX 控件。这组控件不仅能显示数据,也能操作数据(象改变控制参数)。 这个控件包包含六个ActiveX控件, 即SmartButton、Switch、Slider、SwitchSlider、Knob 和 SwitchKnob。 这个控件包的最新版本是3.000,它是在前两个版本的基础上,广泛听取客户需求,改进存在的不便之处, 增加了一些新的控件,在原有的控件上增加了不少新功能, 同时也改进了运行品质。 SmartButton (时尚按钮)控件能用在任何需要按钮的应用中, 象园角方形按钮、菱形按钮、三角按钮、园形或椭园按钮、悬浮按钮、箭头按钮以及其他用户可设置的按钮。 所有的按钮都能设置成不同的按钮表面着色方式(平淡型(Flat)、三维型(3D)、梯度型(Gradient))。 Switch (开关)控件是用来表示“真/假”或 “开/关”等触发开关。它的显示界面是用户可设置的,用户可以提供自己的开/关图象或使用控件预定义的一些三维开关样式。 Slider(滑块调节器)控件是一个模拟游标滑尺来控制或调整参数的一个控件, 它提供了许多特性供开发者设置控件外表,它特别提供了很多种类的游标滑块供选择。SwitchSlider (选择滑块调节器)控件有和Slider控件一样外观设置, 开发者可以用它提供许多控制选择项或操作选择项让最终用户来选择(类似“选择开关”),或提供一些某些变量的离散值供最终用户来选择,Slider控件却处理的是连续变量。 Knob (旋钮调节器)/ SwitchKnob (选择旋钮调节器)和 Slider/SwitchSlider 相类似。Knob是一个开发者可灵活配置的多用途的园行旋转组件来设置或连续调节某一变量的值, SwitchKnob是一个旋钮调节器来选择某一选项的离散选择控件。 开发者可以买整个软件包,或只买其中一个或几个子软件包。 对每个控件,我们将提供帮助文件(PDF),使用例程(VB6, VC6, HTML, C#, VB.NET,VBA(Excel))等来指导你如何使用这些控件到你的应用程序中去,了解这些控件提供了什么功能。
自动生成VBA窗体菜单 '*************************** '* 菜单类 * '*************************** Option Explicit Private WithEvents MenuBar_MenuItem As MSForms.Label '菜单项 Private WithEvents WorkForm As MSForms.UserForm '工作窗口 Private WithEvents MenuBar As MSForms.Image '菜单栏 Private BackMenu_BackGroud As MSForms.Image '菜单背景图片 Private BackMenu_Caption As MSForms.Label '菜单标题标签 Private Const DISTANCE As Integer = 5 '菜单与左边框距离 Private Const MENUTOP As Integer = 2 '菜单项顶点Y轴位置 Private Const MENUHEIGHT As Integer = 14 '菜单项高度 Private intIndex As Integer '索引变量 Private sAction As String '宏名称变量 Private Property Let Index(N As Byte) '指定索引属性 intIndex = N End Property Private Property Get Index() As Byte '获得陇望蜀索引属性 Index = intIndex End Property Private Property Let OnAction(sAct As String) '行为属性 sAction = sAct End Property Private Property Get OnAction() As String OnAction = sAction End Property Public Sub AddMenu(wform As MSForms.UserForm, sCaption As String, sAction As String, Optional Acc As String = vbNullString) Dim MenuLeft As Single, MenuWidth As Single '由两个标签和一个图形控件组成一个主菜单项 MenuCount = MenuCount + 1 '主菜单项总数加1 Index = MenuCount '设置索引 Set WorkForm = wform With WorkForm Set MenuBar = .FormMenuBar Set BackMenu_Caption = .Controls.Add("forms.label.1") '添加一个标签,显示菜单标题 With BackMenu_Caption .Accelerator = Acc .AutoSize = True .BackStyle = fmBackStyleTransparent .Caption = sCaption .Font = "宋体" .Font.Size = 9 .Name = "BackMenu_Caption" & MenuCount .TextAlign = fmTextAlignCenter .Top = MENUTOP + 3 .WordWrap = False .Visible = True End With If MenuCount = 1 Then MenuLeft = DISTANCE Else With .Controls("BackMenu_Caption" & MenuCount - 1) MenuLeft = .Left + .Width End With End If MenuWidth = BackMenu_Caption.Width + 10 Set BackMenu_BackGroud = .Controls.Add("forms.image.1") '添加一个image,作为背景图片 With BackMenu_BackGroud .Name = "BackMenu_BackGroud" & MenuCount .BorderStyle = fmBorderStyleNone .Move MenuLeft, MENUTOP, MenuWidth, MENUHEIGHT .BackStyle = fmBackStyleTransparent .PictureSizeMode = fmPictureSizeModeStretch BackMenu_Caption.AutoSize = False BackMenu_Caption.Left = .Left BackMenu_Caption.Width = .Width End With BackMenu_Caption.ZOrder '将标签置前 Set MenuBar_MenuItem = .Controls.Add("forms.label.1") '添加一个Label,用于触发事件 With MenuBar_MenuItem .Name = "MenuBar_MenuItem" & MenuCount .BorderStyle = fmBorderStyleNone .BackStyle = fmBackStyleTransparent With BackMenu_BackGroud MenuBar_MenuItem.Move .Left, .Top, .Width, .Height End With End With End With OnAction = sAction End Sub Private Sub MenuBar_MenuItem_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button = 1 Then bMenuSelected = True: Menu_Select End Sub Private Sub MenuBar_Click() UnSelectLastMenu bMenuSelected = False End Sub Private Sub MenuBar_MenuItem_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) UnSelectLastMenu Call Menu_Select End Sub Private Sub MenuBar_MouseMove1(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Not bMenuSelected Then UnSelectLastMenu End Sub Private Sub WorkForm_Click() '窗体单击时 UnSelectLastMenu bMenuSelected = False End Sub Private Sub WorkForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Not bMenuSelected Then UnSelectLastMenu '窗体 End Sub Private Sub Menu_Select() '选择菜单 On Error Resume Next Dim Pt_Menu_RightBottom As POINTAPI, Pt_Menu_LeftTop As POINTAPI With WorkForm UnSelectLastMenu Set LastSelect_Menu = BackMenu_BackGroud With BackMenu_BackGroud .BorderStyle = fmBorderStyleSingle .BorderColor = RGB(0, 0, 128) .BackStyle = fmBackStyleOpaque If bMenuSelected = False Then WorkForm.Controls("BackMenu_BackGroud" & Index).BackColor = &HFFC0C0 Else WorkForm.Controls("BackMenu_BackGroud" & Index).BackColor = &HE0E0E0 pt.X = MenuBar_MenuItem.Left * 1.33 pt.Y = (MenuBar_MenuItem.Top + MenuBar_MenuItem.Height) * 1.33 + 3 ClientToScreen hForm, pt If OnAction "" Then Application.Run OnAction End If End If End With End With End Sub Private Sub UnSelectLastMenu() '取消上次选择 If Not LastSelect_Menu Is Nothing Then With LastSelect_Menu .Picture = LoadPicture() .BackStyle = fmBackStyleTransparent .BorderStyle = fmBorderStyleNone End With End If End Sub '********本模块结束********** '*************************** '* 菜单执行模块 * '*************************** Public Type POINTAPI X As Long Y As Long End Type Public Declare Function FindWindow Lib "user32.dll" Alias"FindWindowA"(ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function ClientToScreen Lib"user32"(ByVal hwnd As Long, lpPoint As POINTAPI) As Long Public Popup_Menu As CommandBar '指定弹出式菜单 Public LastSelect_Menu As MSForms.Image '最后选择的菜单 Public MenuCount As Integer '子菜单数量 Public hForm As Long '窗口句柄 Public intLevel As Integer '级别标识,用于设置Radio菜单(游戏菜单中:初级,中级,高级) Public bAbortEnabled As Boolean '标识放弃菜单项是否可用 Public bItemCheck As Boolean '标识音效菜单是否CheckOn Public bMenuSelected As Boolean '标识菜单是否点击 Public pt As POINTAPI '定义点 Public faceid As Integer '图标ID Public faceidselect As Integer '选择的图标 Public fistid As Integer '第一个图标号 Public lastid As Integer '最后一个图标号 Public selectrow,selectcol as integer Public Mcro(50) AS String SUB 文件() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "打开 ", "", False, True,33,"" AddCustomCommandBarPopup1 "新建 ", "BB", False, True,18,"" AddCustomCommandBarPopup2 ("另存为 ") Set cmb = Application.CommandBars("CELL").Controls("另存为 ") AddCustomCommandBarPopup3 cmb, "OFFICE 97-2003文件 ", "DD", False, True, 3, "" Set cmb = Application.CommandBars("CELL").Controls("另存为 ") AddCustomCommandBarPopup4 cmb, "OFFICE 2007工作表 " Set cmb = Application.CommandBars("CELL").Controls("另存为 ").Controls("OFFICE 2007工作表 ") AddCustomCommandBarPopup3 cmb, "office 2007启用宏的工作表 ", "FF", False, True, 0, "" Set cmb = Application.CommandBars("CELL").Controls("另存为 ").Controls("OFFICE 2007工作表 ") AddCustomCommandBarPopup3 cmb, "OFFICE 2007工作表 ", "GG", False, True, 253, "" Popup_Menu.ShowPopup pt.X, pt.Y END SUB SUB 公式() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "文本 ", "WB", False, True,7,"" AddCustomCommandBarPopup2 ("名称 ") Set cmb = Application.CommandBars("CELL").Controls("名称 ") AddCustomCommandBarPopup3 cmb, "定义 ", "DY", False, True, 0, "" Set cmb = Application.CommandBars("CELL").Controls("名称 ") AddCustomCommandBarPopup4 cmb, "单元格 " Set cmb = Application.CommandBars("CELL").Controls("名称 ").Controls("单元格 ") AddCustomCommandBarPopup3 cmb, "合并 ", "HB", False, True, 592, "" Set cmb = Application.CommandBars("CELL").Controls("名称 ").Controls("单元格 ") AddCustomCommandBarPopup3 cmb, "从属 ", "CS", False, True, 564, "" Popup_Menu.ShowPopup pt.X, pt.Y END SUB SUB 开发工具() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "插入 ", "CR", False, True,548,"" AddCustomCommandBarPopup1 "模式 ", "MS", False, True,590,"" AddCustomCommandBarPopup2 ("宏 ") Set cmb = Application.CommandBars("CELL").Controls("宏 ") AddCustomCommandBarPopup3 cmb, "录制宏 ", "LZH", False, True, 205, "" Set cmb = Application.CommandBars("CELL").Controls("宏 ") AddCustomCommandBarPopup3 cmb, "安全性 ", "AQX", False, True, 279, "" Set cmb = Application.CommandBars("CELL").Controls("宏 ") AddCustomCommandBarPopup3 cmb, "查看代码 ", "CKDM", False, True, 289, "" Popup_Menu.ShowPopup pt.X, pt.Y END SUB SUB 窗口() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "并列比较 ", "BLBJ", False, True,250,"" AddCustomCommandBarPopup1 "冻结 ", "DJ", False, True,288,"" AddCustomCommandBarPopup1 "隐藏 ", "YC", False, True,237,"" AddCustomCommandBarPopup1 "拆分 ", "CF", False, True,292,"" AddCustomCommandBarPopup1 "取消冻结 ", "QXDJ", False, True,232,"" Popup_Menu.ShowPopup pt.X, pt.Y END SUB SUB 工具() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "拼写检查 ", "PXJC", False, True,246,"" AddCustomCommandBarPopup2 ("保护 ") Set cmb = Application.CommandBars("CELL").Controls("保护 ") AddCustomCommandBarPopup3 cmb, "保护工作表 ", "BHGZB", False, True, 277, "" Set cmb = Application.CommandBars("CELL").Controls("保护 ") AddCustomCommandBarPopup3 cmb, "保护工作薄 ", "BHGZBB", False, True, 312, "" Set cmb = Application.CommandBars("CELL").Controls("保护 ") AddCustomCommandBarPopup3 cmb, "工作表菜单栏 ", "gzbcdl", False, True, 142, "" Set cmb = Application.CommandBars("CELL").Controls("保护 ") AddCustomCommandBarPopup3 cmb, "图表菜单栏 ", "tbgjl", False, True, 164, "" Popup_Menu.ShowPopup pt.X, pt.Y END SUB SUB 常用() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "格式 ", "gs", False, True,108,"" AddCustomCommandBarPopup1 "数据透视表 ", "sjtsb", False, True,125,"" AddCustomCommandBarPopup1 "图表 ", "tb", False, True,127,"" AddCustomCommandBarPopup1 "审阅 ", "sy", False, True,124,"" AddCustomCommandBarPopup1 "窗体 ", "ct", False, True,128,"" AddCustomCommandBarPopup1 "停止录制 ", "tzlz", False, True,185,"" AddCustomCommandBarPopup2 ("外部数据 ") Set cmb = Application.CommandBars("CELL").Controls("外部数据 ") AddCustomCommandBarPopup3 cmb, "公式审核 ", "gssh", False, True, 129, "" Set cmb = Application.CommandBars("CELL").Controls("外部数据 ") AddCustomCommandBarPopup3 cmb, "全屏显示 ", "qpxs", False, True, 130, "" Set cmb = Application.CommandBars("CELL").Controls("外部数据 ") AddCustomCommandBarPopup3 cmb, "循环引用 ", "xhye", False, True, 132, "" Set cmb = Application.CommandBars("CELL").Controls("外部数据 ") AddCustomCommandBarPopup4 cmb, "VisualBasic " Set cmb = Application.CommandBars("CELL").Controls("外部数据 ").Controls("VisualBasic ") AddCustomCommandBarPopup3 cmb, "Web ", "web", False, True, 173, "" Set cmb = Application.CommandBars("CELL").Controls("外部数据 ").Controls("VisualBasic ") AddCustomCommandBarPopup3 cmb, "控件工具箱 ", "kjgjx", False, True, 174, "" Set cmb = Application.CommandBars("CELL").Controls("外部数据 ").Controls("VisualBasic ") AddCustomCommandBarPopup3 cmb, "退出设计模式 ", "tcsjms", False, True, 162, "" Set cmb = Application.CommandBars("CELL").Controls("外部数据 ").Controls("VisualBasic ") AddCustomCommandBarPopup3 cmb, "刷新 ", "sx", False, True, 165, "" Set cmb = Application.CommandBars("CELL").Controls("外部数据 ").Controls("VisualBasic ") AddCustomCommandBarPopup3 cmb, "监视窗口 ", "jsck", False, True, 168, "" Set cmb = Application.CommandBars("CELL").Controls("外部数据 ").Controls("VisualBasic ") AddCustomCommandBarPopup3 cmb, "数据透视表字段列表 ", "sjtsbzdb", False, True, 170, "" Set cmb = Application.CommandBars("CELL").Controls("外部数据 ").Controls("VisualBasic ") AddCustomCommandBarPopup3 cmb, "边框 ", "bk", False, True, 178, "" Set cmb = Application.CommandBars("CELL").Controls("外部数据 ").Controls("VisualBasic ") AddCustomCommandBarPopup3 cmb, "保护 ", "bh", False, True, 160, "" Set cmb = Application.CommandBars("CELL").Controls("外部数据 ").Controls("VisualBasic ") AddCustomCommandBarPopup3 cmb, "文本到语音 ", "wbdyy", False, True, 164, "" Popup_Menu.ShowPopup pt.X, pt.Y END SUB SUB 列表() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "并排比较 ", "bpbj1", False, True,180,"" AddCustomCommandBarPopup1 "绘图 ", "bpbj2", False, True,182,"" AddCustomCommandBarPopup1 "数据透视图菜单 ", "bpbj3", False, True,184,"" AddCustomCommandBarPopup2 ("工作簿标签 ") AddCustomCommandBarPopup2 ("单元格 ") Set cmb = Application.CommandBars("CELL").Controls("单元格 ") AddCustomCommandBarPopup3 cmb, "列 ", "bpbj6", False, True, 190, "" Set cmb = Application.CommandBars("CELL").Controls("单元格 ") AddCustomCommandBarPopup3 cmb, "行 ", "bpbj7", False, True, 192, "" Set cmb = Application.CommandBars("CELL").Controls("单元格 ") AddCustomCommandBarPopup3 cmb, "单元格 ", "bpbj8", False, True, 194, "" Set cmb = Application.CommandBars("CELL").Controls("单元格 ") AddCustomCommandBarPopup3 cmb, "柱形图 ", "bpbj9", False, True, 196, "" Set cmb = Application.CommandBars("CELL").Controls("单元格 ") AddCustomCommandBarPopup3 cmb, "行 ", "bpbj10", False, True, 198, "" Set cmb = Application.CommandBars("CELL").Controls("单元格 ") AddCustomCommandBarPopup4 cmb, "工作表 " Set cmb = Application.CommandBars("CELL").Controls("单元格 ").Controls("工作表 ") AddCustomCommandBarPopup3 cmb, "XLM 单元格 ", "bpbj12", False, True, 202, "" Set cmb = Application.CommandBars("CELL").Controls("单元格 ").Controls("工作表 ") AddCustomCommandBarPopup3 cmb, "文档 ", "bpbj13", False, True, 204, "" Set cmb = Application.CommandBars("CELL").Controls("单元格 ").Controls("工作表 ") AddCustomCommandBarPopup3 cmb, "桌面 ", "bpbj14", False, True, 206, "" Set cmb = Application.CommandBars("CELL").Controls("单元格 ").Controls("工作表 ") AddCustomCommandBarPopup3 cmb, "非默认拖放 ", "bpbj15", False, True, 208, "" Set cmb = Application.CommandBars("CELL").Controls("单元格 ").Controls("工作表 ") AddCustomCommandBarPopup3 cmb, "自动填充 ", "bpbj16", False, True, 210, "" Set cmb = Application.CommandBars("CELL").Controls("单元格 ").Controls("工作表 ") AddCustomCommandBarPopup3 cmb, "按钮 ", "bpbj17", False, True, 212, "" Set cmb = Application.CommandBars("CELL").Controls("单元格 ").Controls("工作表 ") AddCustomCommandBarPopup3 cmb, "对话框 ", "bpbj18", False, True, 214, "" Popup_Menu.ShowPopup pt.X, pt.Y END SUB SUB 序列() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "图形区 ", "bpbj20", False, True,218,"" AddCustomCommandBarPopup1 "基底和墙纸 ", "bpbj21", False, True,220,"" AddCustomCommandBarPopup1 "趋势线 ", "bpbj22", False, True,222,"" AddCustomCommandBarPopup1 "图表 ", "bpbj23", False, True,224,"" AddCustomCommandBarPopup1 "设置数据系列格式 ", "bpbj24", False, True,226,"" AddCustomCommandBarPopup2 ("设置数据轴格式 ") Set cmb = Application.CommandBars("CELL").Controls("设置数据轴格式 ") AddCustomCommandBarPopup3 cmb, "设置图例项格式 ", "bpbj26", False, True, 230, "" Set cmb = Application.CommandBars("CELL").Controls("设置数据轴格式 ") AddCustomCommandBarPopup3 cmb, "编辑栏 ", "bpbj27", False, True, 232, "" Set cmb = Application.CommandBars("CELL").Controls("设置数据轴格式 ") AddCustomCommandBarPopup3 cmb, "数据透视表上下文菜单 ", "bpbj28", False, True, 234, "" Set cmb = Application.CommandBars("CELL").Controls("设置数据轴格式 ") AddCustomCommandBarPopup3 cmb, "查询 ", "bpbj29", False, True, 236, "" Set cmb = Application.CommandBars("CELL").Controls("设置数据轴格式 ") AddCustomCommandBarPopup3 cmb, "查询布局 ", "bpbj30", False, True, 238, "" Set cmb = Application.CommandBars("CELL").Controls("设置数据轴格式 ") AddCustomCommandBarPopup4 cmb, "自动计算 " Set cmb = Application.CommandBars("CELL").Controls("设置数据轴格式 ").Controls("自动计算 ") AddCustomCommandBarPopup3 cmb, "对象/图形区 ", "bpbj32", False, True, 242, "" Set cmb = Application.CommandBars("CELL").Controls("设置数据轴格式 ").Controls("自动计算 ") AddCustomCommandBarPopup3 cmb, "标题栏(图表) ", "bpbj33", False, True, 244, "" Popup_Menu.ShowPopup pt.X, pt.Y END SUB SUB 框架() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "数据透视图快捷菜单 ", "bpbj35", False, True,248,"" AddCustomCommandBarPopup1 "拼音信息 ", "bpbj36", False, True,250,"" AddCustomCommandBarPopup1 "自动合计 ", "bpbj37", False, True,252,"" AddCustomCommandBarPopup1 "选择性粘贴下拉框 ", "bpbj38", False, True,254,"" AddCustomCommandBarPopup2 ("查找格式 ") Set cmb = Application.CommandBars("CELL").Controls("查找格式 ") AddCustomCommandBarPopup3 cmb, "替换格式 ", "bpbj40", False, True, 258, "" Set cmb = Application.CommandBars("CELL").Controls("查找格式 ") AddCustomCommandBarPopup3 cmb, "列表区域快捷菜单 ", "bpbj41", False, True, 260, "" Set cmb = Application.CommandBars("CELL").Controls("查找格式 ") AddCustomCommandBarPopup3 cmb, "列表区域布局快捷菜单 ", "bpbj42", False, True, 262, "" Set cmb = Application.CommandBars("CELL").Controls("查找格式 ") AddCustomCommandBarPopup3 cmb, "XML 区域快捷菜单 ", "bpbj43", False, True, 264, "" Set cmb = Application.CommandBars("CELL").Controls("查找格式 ") AddCustomCommandBarPopup3 cmb, "列表区域布局快捷菜单 ", "bpbj44", False, True, 266, "" Set cmb = Application.CommandBars("CELL").Controls("查找格式 ") AddCustomCommandBarPopup3 cmb, "艺术字 ", "bpbj45", False, True, 268, "" AddCustomCommandBarPopup2 ("图片 ") Set cmb = Application.CommandBars("CELL").Controls("图片 ") AddCustomCommandBarPopup3 cmb, "阴影设置 ", "bpbj47", False, True, 272, "" AddCustomCommandBarPopup2 ("三维设置 ") Set cmb = Application.CommandBars("CELL").Controls("三维设置 ") AddCustomCommandBarPopup3 cmb, "绘图画布 ", "bpbj49", False, True, 276, "" Set cmb = Application.CommandBars("CELL").Controls("三维设置 ") AddCustomCommandBarPopup3 cmb, "组织结构图 ", "bpbj50", False, True, 278, "" Set cmb = Application.CommandBars("CELL").Controls("三维设置 ") AddCustomCommandBarPopup3 cmb, "图示 ", "bpbj51", False, True, 280, "" Set cmb = Application.CommandBars("CELL").Controls("三维设置 ") AddCustomCommandBarPopup3 cmb, "墨迹绘图与书写 ", "bpbj52", False, True, 282, "" Set cmb = Application.CommandBars("CELL").Controls("三维设置 ") AddCustomCommandBarPopup3 cmb, "墨迹注释 ", "bpbj53", False, True, 284, "" AddCustomCommandBarPopup2 ("边框 ") Set cmb = Application.CommandBars("CELL").Controls("边框 ") AddCustomCommandBarPopup3 cmb, "边框 ", "bpbj55", False, True, 288, "" Set cmb = Application.CommandBars("CELL").Controls("边框 ") AddCustomCommandBarPopup4 cmb, "绘图边框 " Set cmb = Application.CommandBars("CELL").Controls("边框 ").Controls("绘图边框 ") AddCustomCommandBarPopup3 cmb, "图表类型 ", "bpbj57", False, True, 292, "" Set cmb = Application.CommandBars("CELL").Controls("边框 ").Controls("绘图边框 ") AddCustomCommandBarPopup3 cmb, "图案 ", "bpbj58", False, True, 294, "" Set cmb = Application.CommandBars("CELL").Controls("边框 ").Controls("绘图边框 ") AddCustomCommandBarPopup3 cmb, "字体颜色 ", "bpbj59", False, True, 296, "" Popup_Menu.ShowPopup pt.X, pt.Y END SUB SUB 填充颜色() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "线条颜色 ", "bpbj61", False, True,300,"" AddCustomCommandBarPopup2 ("绘图与书写笔 ") Set cmb = Application.CommandBars("CELL").Controls("绘图与书写笔 ") AddCustomCommandBarPopup3 cmb, "批注笔 ", "bpbj63", False, True, 304, "" Set cmb = Application.CommandBars("CELL").Controls("绘图与书写笔 ") AddCustomCommandBarPopup3 cmb, "绘图和书写笔 ", "bpbj64", False, True, 306, "" Set cmb = Application.CommandBars("CELL").Controls("绘图与书写笔 ") AddCustomCommandBarPopup3 cmb, "注释笔 ", "bpbj65", False, True, 308, "" Set cmb = Application.CommandBars("CELL").Controls("绘图与书写笔 ") AddCustomCommandBarPopup3 cmb, "叠放次序 ", "bpbj66", False, True, 310, "" Set cmb = Application.CommandBars("CELL").Controls("绘图与书写笔 ") AddCustomCommandBarPopup3 cmb, "微移 ", "bpbj67", False, True, 312, "" Set cmb = Application.CommandBars("CELL").Controls("绘图与书写笔 ") AddCustomCommandBarPopup3 cmb, "对齐或分布 ", "bpbj68", False, True, 314, "" AddCustomCommandBarPopup2 ("旋转或翻转 ") Set cmb = Application.CommandBars("CELL").Controls("旋转或翻转 ") AddCustomCommandBarPopup3 cmb, "直线 ", "bpbj70", False, True, 318, "" Set cmb = Application.CommandBars("CELL").Controls("旋转或翻转 ") AddCustomCommandBarPopup4 cmb, "连接符 " Set cmb = Application.CommandBars("CELL").Controls("旋转或翻转 ").Controls("连接符 ") AddCustomCommandBarPopup3 cmb, "自选图形 ", "bpbj72", False, True, 322, "" Set cmb = Application.CommandBars("CELL").Controls("旋转或翻转 ").Controls("连接符 ") AddCustomCommandBarPopup3 cmb, "标注 ", "bpbj73", False, True, 324, "" Popup_Menu.ShowPopup pt.X, pt.Y END SUB SUB 流程图() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "箭头总汇 ", "bpbj75", False, True,328,"" AddCustomCommandBarPopup1 "星与旗帜 ", "bpbj76", False, True,330,"" AddCustomCommandBarPopup1 "基本形状 ", "bpbj77", False, True,332,"" AddCustomCommandBarPopup1 "插入形状 ", "bpbj78", False, True,334,"" AddCustomCommandBarPopup2 ("形状 ") Set cmb = Application.CommandBars("CELL").Controls("形状 ") AddCustomCommandBarPopup3 cmb, "非活动图表 ", "bpbj80", False, True, 338, "" Set cmb = Application.CommandBars("CELL").Controls("形状 ") AddCustomCommandBarPopup3 cmb, "Excel 控件 ", "bpbj81", False, True, 340, "" AddCustomCommandBarPopup1 "曲线 ", "bpbj82", False, True,342,"" AddCustomCommandBarPopup1 "曲线结点 ", "bpbj83", False, True,344,"" AddCustomCommandBarPopup1 "曲线段 ", "bpbj84", False, True,346,"" AddCustomCommandBarPopup1 "图片上下文菜单 ", "bpbj85", False, True,348,"" Popup_Menu.ShowPopup pt.X, pt.Y END SUB SUB OLE对象() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "ActiveX 控件 ", "bpbj87", False, True,352,"" AddCustomCommandBarPopup1 "艺术字上下文菜单 ", "bpbj88", False, True,354,"" AddCustomCommandBarPopup1 "旋转方式 ", "bpbj89", False, True,356,"" AddCustomCommandBarPopup1 "连接符 ", "bpbj90", False, True,358,"" AddCustomCommandBarPopup1 "脚本标记快捷菜单 ", "bpbj91", False, True,360,"" AddCustomCommandBarPopup1 "Canvas Popup ", "bpbj92", False, True,362,"" AddCustomCommandBarPopup1 "Organization Chart Popup ", "bpbj93", False, True,364,"" AddCustomCommandBarPopup2 ("图表 ") Set cmb = Application.CommandBars("CELL").Controls("图表 ") AddCustomCommandBarPopup3 cmb, "选择 ", "bpbj95", False, True, 368, "" Set cmb = Application.CommandBars("CELL").Controls("图表 ") AddCustomCommandBarPopup4 cmb, "版式 " Set cmb = Application.CommandBars("CELL").Controls("图表 ").Controls("版式 ") AddCustomCommandBarPopup3 cmb, "符号栏 ", "bpbj97", False, True, 372, "" Set cmb = Application.CommandBars("CELL").Controls("图表 ").Controls("版式 ") AddCustomCommandBarPopup3 cmb, "任务窗格 ", "bpbj98", False, True, 374, "" Popup_Menu.ShowPopup pt.X, pt.Y END SUB SUB 添加命令() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "内置菜单 ", "bpbj100", False, True,378,"" AddCustomCommandBarPopup1 "剪贴板 ", "bpbj101", False, True,380,"" AddCustomCommandBarPopup1 "信封 ", "bpbj102", False, True,382,"" AddCustomCommandBarPopup1 "联机会议 ", "bpbj103", False, True,384,"" AddCustomCommandBarPopup1 "SnagIt ", "bpbj104", False, True,386,"" Popup_Menu.ShowPopup pt.X, pt.Y END SUB SUB 关于() Clear_menu '清除弹出菜单上菜单项 Dim cmb As CommandBarControl AddCustomCommandBarPopup1 "我的VBA ", "WDVBA", False, True,400,"" AddCustomCommandBarPopup1 "帮助 ", "BZ", False, True,402,"" Popup_Menu.ShowPopup pt.X, pt.Y END SUB Public Sub ClearBar() '清除Cell弹出式菜单中菜单项 Dim ctr As CommandBarControl With Popup_Menu .Enabled = True For Each ctr In .Controls ctr.Delete Next End With End Sub Sub RemoveCustomMenu() '恢复系统菜单的各弹出菜单 Application.CommandBars("CELL").Reset End Sub Sub clear_menu() Dim cmb As Object For Each cmb In Application.CommandBars("cell").Controls Application.CommandBars("cell").Controls(cmb.Caption).Delete Next End Sub Sub AddCustomCommandBarPopup1(Caption As String, Macro As String, NewGroup As Boolean, Enable As Boolean, FId As Integer, ShortT As String) '添加一级菜单选项 Dim cbb As CommandBarButton Set cbb = Application.CommandBars("CELL").Controls.Add(msoControlButton) cbb.Caption = Caption If FId > 0 Then cbb.faceid = FId If ShortT "" Then cbb.ShortcutText = ShortT cbb.OnAction = Macro cbb.BeginGroup = NewGroup cbb.Enabled = Enable End Sub Function AddCustomCommandBarPopup2(Caption As String) As CommandBarControl '添加子菜单项 Dim cmb As CommandBarControl Set cmb = Application.CommandBars("CELL").Controls.Add(msoControlPopup) cmb.Caption = Caption cmb.Visible = True Set AddCustomCommandBarPopup2 = cmb End Function Sub AddCustomCommandBarPopup3(cmb As Object, Caption As String, Macro As String, NewGroup As Boolean, Enable As Boolean, FId As Integer, ShortT As String) '添加一级菜单选项 Dim cbc As CommandBarButton Set cbc = cmb.Controls.Add(msoControlButton) cbc.Caption = Caption If FId > 0 Then cbc.faceid = FId If ShortT "" Then cbc.ShortcutText = ShortT cbc.OnAction = Macro cbc.BeginGroup = NewGroup cbc.Enabled = Enable End Sub Function AddCustomCommandBarPopup4(cmd As CommandBarControl, Caption As String) As CommandBarControl '添加子菜单项 Dim cme As CommandBarControl Set cme = cmd.Controls.Add(msoControlPopup) cme.Caption = Caption cme.Visible = True Set AddCustomCommandBarPopup4 = cme End Function '********本模块结束********** '*************************** '* 窗口模块 * '*************************** Private menu(1 To 50) As New Menu_Class '定义50个cMenu菜单类型 Private Sub UserForm_Initialize() hForm = FindWindow(vbNullString, Me.Caption) '程序中需要用到窗口句柄,先获得它 MenuCount = 0 Set Popup_Menu = Application.CommandBars("Cell") '程序中需指定一个弹出式菜单,我们指定为单元格右键菜单,您可另外指定一个弹出式菜单,请注意,是弹出式菜单 Dim bar As Control Set bar = Me.Controls.Add("Forms.image.1", "IM1", Visible) With bar .Visible = True .Left = -100 .Top = 0 .Height = 20 .Width = 20 .BackColor = &HFFC0C0 .BorderStyle = 0 End With '*************** Set bar = Me.Controls.Add("Forms.image.1", "IM2", Visible) With bar .Visible = True .Left = -100 .Top = 0 .Height = 20 .Width = 20 .BackColor = &HFFC0C0 .BorderStyle = 0 End With '*************** Set bar = Me.Controls.Add("Forms.image.1", "FormMenuBar", Visible) With bar .Visible = True .Left = -1 .Top = -1 .Height = 20 .Width = 2000 .BackColor = &HFFC0C0 .BorderStyle = 0 End With menu(1).AddMenu Me,"文件","文件","" menu(2).AddMenu Me,"公式","公式","" menu(3).AddMenu Me,"开发工具","开发工具","" menu(4).AddMenu Me,"窗口","窗口","" menu(5).AddMenu Me,"工具","工具","" menu(6).AddMenu Me,"常用","常用","" menu(7).AddMenu Me,"列表","列表","" menu(8).AddMenu Me,"序列","序列","" menu(9).AddMenu Me,"框架","框架","" menu(10).AddMenu Me,"填充颜色","填充颜色","" menu(11).AddMenu Me,"流程图","流程图","" menu(12).AddMenu Me,"OLE对象","OLE对象","" menu(13).AddMenu Me,"添加命令","添加命令","" menu(14).AddMenu Me,"关于","关于","" end sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Dim i As Integer For i = LBound(menu) To UBound(menu) Set menu(i) = Nothing Next Popup_Menu.Enabled = True Popup_Menu.Reset end sub '********本模块结束**********

5,139

社区成员

发帖
与我相关
我的任务
社区描述
其他开发语言 Office开发/ VBA
社区管理员
  • Office开发/ VBA社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧