ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: yuanzhuping

VBA常用技巧代码解析

    [复制链接]

TA的精华主题

TA的得分主题

发表于 2009-3-22 10:12 | 显示全部楼层

<<精华技巧,技巧精华>>

本帖已被收录到知识树中,索引项:开发帮助和教程
袁斑竹,不介意我把这里的技巧整理成一本书发到论坛上吧!!!!!!!!!!!!

TA的精华主题

TA的得分主题

发表于 2009-3-22 14:30 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
have a look

TA的精华主题

TA的得分主题

发表于 2009-3-22 16:35 | 显示全部楼层
第7部分 菜单和工具栏
技巧88         禁用工作表右键菜单

请教楼主:
我测试了这个后,excel工作表右键菜单不能用了。必须再次打开你的附件中工作簿点击启用才能。如何解决?

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-3-22 19:26 | 显示全部楼层
原帖由 zyq401 于 2009-3-22 16:35 发表
第7部分 菜单和工具栏
技巧88         禁用工作表右键菜单

请教楼主:
我测试了这个后,excel工作表右键菜单不能用了。必须再次打开你的附件中工作簿点击启用才能。如何解决?

不会呀,在工作簿事件中有恢复的。
  1. Private Sub Workbook_Deactivate()
  2.     Call EnaBar
  3. End Sub
复制代码
禁用后就是没恢复只要关闭示例工作簿后也能启用的。

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-3-22 19:28 | 显示全部楼层
原帖由 ylrshcn 于 2009-3-22 10:12 发表
袁斑竹,不介意我把这里的技巧整理成一本书发到论坛上吧!!!!!!!!!!!!

如果是发到EH论坛当然不介意,我也想整理完成后请人制作成电子书供大家下载。

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-3-22 22:29 | 显示全部楼层

第7部分 菜单和工具栏

技巧93         在工具栏上添加下拉列表框
       如果需要在工具栏中添加类似“字体”这样的下拉列表控制框控件,那么可以使用下面的代码。
  1. #001  Sub AddDropdown()
  2. #002      Dim myDropdown As Object
  3. #003      Dim myCap As Variant
  4. #004      Dim i As Integer
  5. #005      myCap = Array("基础应用", "VBA程序开发", "函数与公式")
  6. #006      Call DeleteButton
  7. #007      Set myDropdown = Application.CommandBars("Formatting").Controls _
  8. #008          .Add(Type:=msoControlDropdown, Before:=1)
  9. #009      With myDropdown
  10. #010          .Caption = "请选择版块"
  11. #011          .OnAction = "myOnA"
  12. #012          .Style = msoComboNormal
  13. #013          For i = 0 To UBound(myCap)
  14. #014              .AddItem myCap(i)
  15. #015          Next
  16. #016          .ListIndex = 1
  17. #017      End With
  18. #018  End Sub
  19. #019  Sub DeleteButton()
  20. #020      With Application.CommandBars("Formatting").Controls(1)
  21. #021          If .Caption = "请选择版块" Then .Delete
  22. #022      End With
  23. #023  End Sub
  24. #024  Sub myOnA()
  25. #025      Dim myList As Byte
  26. #026      myList = Application.CommandBars("Formatting") _
  27. #027          .Controls(1).ListIndex
  28. #028      ActiveWorkbook.FollowHyperlink _
  29. #029      Address:="http://club.excelhome.net/forum-" & myList & "-1.html", NewWindow:=True
  30. #030  End Sub
复制代码
代码解析:
       AddDropdown过程使用Add方法在工具栏中添加下拉列表控制框控件。
       第5行代码使用Array函数创建一个数组用于保存下拉列表控制框控件加载列表项所需的元素。
        第6行代码先运行第19行到第23行的DeleteButton过程删除可能存在的下拉列表控制框控件,以免重复添加。DeleteButton过程判断工具栏中第一个控件的Caption属性是否为“请选择版块”,如果是则删除该下拉列表控制框控件。
       第7、8行代码使用Add方法在工具栏中添加下拉列表控制框控件。应用于 CommandBarControls 对象的Add方法请参阅技巧79 。示例中将其参数Type设置为msoControlDropdown,添加的就是下拉列表控制框控件。
       第10行代码设置下拉列表控制框控件的Caption属性,应用于 CommandBarControls 对象的Caption属性返回或设置指定命令栏控件的题注文字,也可作为默认的“屏幕提示”显示。
       第11行代码设置改变下拉列表控制框控件的内容时要运行的过程为第24行到第30行代码的myOnA过程。myOnA过程根据下拉列表控制框控件的ListIndex属性值打开Excel Home论坛中相应的版块。
       第12行代码设置下拉列表控制框控件的样式。Style属性返回或设置命令栏控件的显示方式,该属性值可设置为表格所列MsoComboStyle常量之一。
Snap2.jpg
       第13行到第15行代码使用AddItem方法将数组中的元素添加到下拉列表控制框控件的列表项中。
       第16行代码将下拉列表控制框控件的ListIndex属性设置为1,使其显示第一条列表项。
       运行AddDropdown过程,工具栏如图所示。
Snap1.jpg

技巧93 在工具栏上添加下拉列表框.rar

8.22 KB, 下载次数: 1243

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-3-23 08:07 | 显示全部楼层

第7部分 菜单和工具栏

技巧94         屏蔽工作表的复制功能
       有时我们并不希望用户对工作表中的数据进行复制粘贴操作,此时可以把所有的复制功能都屏蔽,如下面的代码所示。
  1. #001      Dim CmdCtrls As CommandBarControls
  2. #002      Dim Cmd As CommandBarControl
  3. #003  Sub ProCopy()
  4. #004      Set CmdCtrls = Application.CommandBars.FindControls(ID:=19)
  5. #005      For Each Cmd In CmdCtrls
  6. #006          Cmd.Enabled = False
  7. #007      Next
  8. #008      Application.CellDragAndDrop = False
  9. #009      Application.OnKey ("^c"), ""
  10. #010  End Sub
  11. #011  Sub StaCopy()
  12. #012      Set CmdCtrls = Application.CommandBars.FindControls(ID:=19)
  13. #013      For Each Cmd In CmdCtrls
  14. #014          Cmd.Enabled = True
  15. #015      Next
  16. #016      Application.CellDragAndDrop = True
  17. #017      Application.OnKey ("^c")
  18. #018  End Sub
复制代码
代码解析:
       第1、2行代码在模块顶部声明两个模块级的变量。
       第3行到第10行代码ProCopy过程,屏蔽工作表中所有的复制功能。其中第4行到第7行代码使用FindControls方法将所有与“复制”相关的命令栏控件赋给变量CmdCtrls后将其Enabled设置为False。关于FindControls方法请参阅技巧80 。
       第8行代码屏蔽单元格拖放功能,关于应用于Application对象的CellDragAndDrop属性请参阅技巧10 。
       第9行代码屏蔽<Ctrl+C>组合键功能,关于应用于Application 对象的OnKey方法请参阅技巧68 。
       第11行到第18行代码StaCopy过程,恢复所有的复制功能。

技巧94 屏蔽工作表的复制功能.rar

7.08 KB, 下载次数: 1120

TA的精华主题

TA的得分主题

发表于 2009-3-23 09:13 | 显示全部楼层
原帖由 yuanzhuping 于 2009-3-22 19:26 发表

不会呀,在工作簿事件中有恢复的。Private Sub Workbook_Deactivate()
    Call EnaBar
End Sub禁用后就是没恢复只要关闭示例工作簿后也能启用的。


不知道什么原因,就是不能恢复,只有重新打开下载的示例工作表点击启用才行。我试了无数次了。我是2003与2007共存。

TA的精华主题

TA的得分主题

发表于 2009-3-23 10:22 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

自动建立工作表目录相关问题

yuan版主:您好!您真是太辛苦了。请教一个问题:若将技巧27 自动建立工作表目录的工作表名称从E6:J6向下排放,怎么写代码呀?谢谢!
自动建立工作表目录.gif

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-3-23 11:29 | 显示全部楼层
原帖由 ykx042907 于 2009-3-23 10:22 发表
yuan版主:您好!您真是太辛苦了。请教一个问题:若将技巧27 自动建立工作表目录的工作表名称从E6:J6向下排放,怎么写代码呀?谢谢!
  1. Private Sub Worksheet_Activate()
  2.     Dim sh As Worksheet
  3.     Dim a As Integer
  4.     Dim R As Integer
  5.     Dim rng As Range
  6.     R = Abs(Int(-(Worksheets.Count - 1) / 6)) + 5
  7.     a = 1
  8.     Set rng = Sheet1.Range("E6:J" & R)
  9.     rng.ClearContents
  10.     For Each sh In Worksheets
  11.         If sh.CodeName <> "Sheet1" Then
  12.             rng(a) = sh.Name
  13.             a = a + 1
  14.         End If
  15.     Next
  16. End Sub
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-15 02:03 , Processed in 0.052470 second(s), 7 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表