VBA常用技巧代码解析

ylrshcn

袁斑竹,不介意我把这里的技巧整理成一本书发到论坛上吧!!!!!!!!!!!!

dennypeng

have a look

zyq401

第7部分 菜单和工具栏
技巧88         禁用工作表右键菜单

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

yuanzhuping

原帖由 zyq401 于 2009-3-22 16:35 发表
第7部分 菜单和工具栏
技巧88         禁用工作表右键菜单

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

不会呀，在工作簿事件中有恢复的。

1. Private Sub Workbook_Deactivate()
   
2.     Call EnaBar
   
3. End Sub

复制代码

禁用后就是没恢复只要关闭示例工作簿后也能启用的。

yuanzhuping

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

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

yuanzhuping

技巧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常量之一。

       第13行到第15行代码使用AddItem方法将数组中的元素添加到下拉列表控制框控件的列表项中。
       第16行代码将下拉列表控制框控件的ListIndex属性设置为1，使其显示第一条列表项。
       运行AddDropdown过程，工具栏如图所示。

yuanzhuping

技巧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过程，恢复所有的复制功能。

zyq401

原帖由 yuanzhuping 于 2009-3-22 19:26 发表

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

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

ykx042907

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

yuanzhuping

原帖由 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

复制代码