VBA常用技巧代码解析

ykx042907

提问：袁版主，真是太辛苦了！此第7部分 菜单和工具栏附件中没有技巧97（恢复EXCEL命令栏） [/quote]
袁版主：您好！不好意思，本人还没有看清楚，就说您的不是了。其实技巧97是没有附件的。SORRY。

yuanzhuping

技巧99         文本框添加右键快捷菜单
       VBA中的控件没有提供右键快捷菜单，用户可以使用Excel 中的命令栏自已添加右键快捷菜单。
       步骤1：按<Alt+F11>组合键进入VBE窗口，单击菜单“插入”→“模块”，在其代码窗口输入以下代码：

1. #001  Private ActiveTB As MSForms.TextBox
   
2. #002  Public Sub CreateShortCutMenu()
   
3. #003      Dim ShortCutMenu As CommandBar
   
4. #004      Dim ShortCutMenuItem As CommandBarButton
   
5. #005      Dim sCaption As Variant
   
6. #006      Dim iFaceId As Variant
   
7. #007      Dim sAction As Variant
   
8. #008      Dim i As Integer
   
9. #009      sCaption = Array("剪切(&C)", "复制(&T)", "贴粘(&P)", "删除(&D)")
   
10. #010      iFaceId = Array(21, 19, 22, 1786)
    
11. #011      sAction = Array("Action_Cut", "Action_Copy", "Action_Paste", "Action_Delete")
    
12. #012      On Error Resume Next
    
13. #013      Application.CommandBars("ShortCut").Delete
    
14. #014      Set ShortCutMenu = Application.CommandBars.Add("ShortCut", msoBarPopup)
    
15. #015      With ShortCutMenu
    
16. #016          For i = 0 To 3
    
17. #017              Set ShortCutMenuItem = .Controls.Add(msoControlButton)
    
18. #018              With ShortCutMenuItem
    
19. #019                  .Caption = sCaption(i)
    
20. #020                  .faceID = Val(iFaceId(i))
    
21. #021                  .OnAction = sAction(i)
    
22. #022              End With
    
23. #023          Next
    
24. #024      End With
    
25. #025  End Sub

复制代码

代码解析：
       第1行代码，在模块级别中声明变量ActiveTB是用来对应窗体中的文本框所触发的所有事件的变量。
       CreateShortCutMenu过程用来创建标题为“ShortCut”的右键快捷菜单，并添加4个菜单项。关于自定义右键快捷菜单请参阅技巧86 。

1. #001  Public Sub ShowPopupMenu(txtCtr As MSForms.TextBox)
   
2. #002      Dim Action As Variant
   
3. #003      Set ActiveTB = txtCtr
   
4. #004      With Application.CommandBars("ShortCut")
   
5. #005          .Controls(1).Enabled = txtCtr.SelLength > 0
   
6. #006          .Controls(2).Enabled = .Controls(1).Enabled
   
7. #007          .Controls(3).Enabled = txtCtr.CanPaste
   
8. #008          .Controls(4).Enabled = .Controls(1).Enabled
   
9. #009          .ShowPopup
   
10. #010      End With
    
11. #011  End Sub

复制代码

代码解析：
       ShowPopupMenu过程根据文本框中字符的选中状态设置右键快捷菜单菜单项的Enabled属性后使用ShowPopup方法显示右键快捷菜单。
       第5行代码，如果当前文本框中已有选中的字符则“剪切”按钮有效。
       第6行代码，如果当前文本框中已有选中的字符则“复制”按钮有效。
       第7行代码，如果剪贴板中包含对象支持的数据。则“贴粘”按钮有效。
       第8行代码，如果当前文本框中已有选中的字符则“删除”按钮有效。
       第9行代码，显示快捷菜单。

1. #001  Public Sub Action_Cut()
   
2. #002      ActiveTB.Cut
   
3. #003  End Sub
   
4. #004  Public Sub Action_Copy()
   
5. #005      ActiveTB.Copy
   
6. #006  End Sub
   
7. #007  Public Sub Action_Paste()
   
8. #008      ActiveTB.Paste
   
9. #009  End Sub
   
10. #010  Public Sub Action_Delete()
    
11. #011      Dim s As String
    
12. #012      With ActiveTB
    
13. #013          s = .SelText
    
14. #014          .Value = Replace(.Value, s, "")
    
15. #015      End With
    
16. #016  End Sub

复制代码

代码解析：
       Action_Cut过程是快捷菜单中单击“剪切”菜单项所运行的过程。使用Cut 方法将当前选中的文本框中的文本删除并移至剪贴板。
       Action_Copy过程是快捷菜单中单击“复制”菜单项所运行的过程。使用Copy方法将文本框选中的文本复制到剪贴板上。
       Action_Paste过程是快捷菜单中单击“贴粘”菜单项所运行的过程。使用Paste方法把剪贴板上的内容传送到一个文本框中。
       Action_Delete过程是快捷菜单中单击“贴粘”菜单项所运行的过程。使用Replace函数将文本框中选中的文本的文本替换成空字符。

1. #001  Public Sub DeleteShortCutMenu()
   
2. #002      On Error Resume Next
   
3. #003      Application.CommandBars("ShortCut").Delete
   
4. #004  End Sub

复制代码

代码解析：
       DeleteShortCutMenu过程删除创建的右键快捷菜单。
       步骤2：在VBE窗口中，单击菜单“插入”→“用户窗体”，在窗体上添加两个文本框控件。双击窗体，在其代码窗口中输入下面的代码。

1. #001  Private Sub UserForm_Initialize()
   
2. #002      Call CreateShortCutMenu
   
3. #003  End Sub
   
4. #004  Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   
5. #005      If Button = 2 Then ShowPopupMenu ActiveControl
   
6. #006  End Sub
   
7. #007  Private Sub TextBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   
8. #008      If Button = 2 Then ShowPopupMenu ActiveControl
   
9. #009  End Sub
   
10. #010  Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    
11. #011      Call DeleteShortCutMenu
    
12. #012  End Sub

复制代码

代码解析：
       第1行到第3行代码，窗体的Initialize事件，在窗体初始化时运行CreateShortCutMenu过程创建右键快捷菜单。
       第4行到第9行代码，文本框的MouseUp事件，当用户右健单击文本框时运行ShowPopupMenu过程在选中的菜单项上显示右键快捷菜单。
       第10行到第12行代码，窗体的QueryClose事件，在关闭窗体时运行DeleteShortCutMenu过程删除右键快捷菜单。
       窗体运行后，右键单击文本框显示右键快捷菜单，如图所示。

hillbart

谢谢版主无私分享

ykx042907

请问袁版主：何时要用VBA中的API函数和类模块？又如何用？？？

鱼求雨

如此敬业的版主,少见！实乃偶等菜鸟之福哇！

laoluo1

版主你好，很感谢你能为大家上传这些资料。我想请教一下怎样在exce中能使按钮根据鼠标的位置实现动态效果。

liucs1983

像伟大的楼主、伟大的导师、伟大的神致敬！！太感谢了！

gaolinyou

谢谢楼主分享！

yuanzhuping

原帖由 laoluo1 于 2009-3-25 14:00 发表
版主你好，很感谢你能为大家上传这些资料。我想请教一下怎样在exce中能使按钮根据鼠标的位置实现动态效果。

按钮跟随活动单元格吗？在工作表的SelectionChange事件中设置按钮的Top属性等于选定单元格的Top属性，按钮的Left属性等于选定单元格的Left属性加上选定单元格的宽度，即按钮出现在选定单元格的右边。

yuanzhuping

技巧100         文本框回车自动输入
       在使用文本框向工作表输入数据时，为了加快输入速度，可以利用文本框的KeyDown事件，回车后自动输入并清空文本框，如下面的代码所示。

1. #001  Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   
2. #002      With TextBox1
   
3. #003          If Len(Trim(.Value)) > 0 Then
   
4. #004              If KeyCode = vbKeyReturn Then
   
5. #005                  Sheet1.Range("A65536").End(xlUp).Offset(1, 0) = .Value
   
6. #006                  .Text = ""
   
7. #007              End If
   
8. #008          End If
   
9. #009      End With
   
10. #010  End Sub

复制代码

代码解析：
       文本框的KeyDown事件，在输入数据并按<Enter>键后自动将数据录入到工作表A列最后一个非空单元格的下一个单元格中。
       KeyDown事件在按下键盘按键时发生，语法如下：
Private Sub object_KeyDown( ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As fmShiftState)
       参数object是必需的，一个有效的对象。
       参数KeyCode是必需的，代表被按下的键的键代码。
       参数Shift是可选的，Shift、Ctrl 和Alt的状态。
       第3行代码，为了防止误输入空白数据，使用Len 函数和Trim 函数检查文本框内是否为有效数据。
       第4行代码，根据KeyCode参数值判断是否按下了回车键。如果用户按下了回车键，KeyCode参数返回常数vbKeyReturn。
       第5、6行代码，将文本框数据输入到工作表A列的最后一个单元格内，同时清空文本框内容准备下一次输入。

[ 本帖最后由 yuanzhuping 于 2009-3-28 23:27 编辑 ]