VBA常用技巧代码解析

penp

真的很强大！第一：谢谢！第二：占个位子。以后好找！
再次谢谢！

yuanzhuping

原帖由 入孝出悌 于 2009-5-5 12:42 发表

大致还有15天？1月？或者3月到半年？

真的很佩服你，抛开学术，就你的意志就令人敬佩。

呵呵，真的还没有具体的时间，主要是时间安排上，不能保证，毕竟还要工作、生活。在前面多次有朋友说上传完整的Word文档方便大家下载，我只能说这个可以有，但是现在真没有。只有已完成部分的，大家可以到2楼以下的各部分链接中找下下载的楼层。
现在大概已完成了2/3，估计还要2个月左右。

[ 本帖最后由 yuanzhuping 于 2009-5-5 16:47 编辑 ]

yuanzhuping

技巧135         用户窗体添加图标
       用户窗体在显示时标题栏上是没有图标的，如果希望在窗体上添加图标，可以借助API函数在窗体显示时添加自定义的图标。
       在VBE窗口中单击菜单“插入”→“用户窗体”，插入一个窗体，在窗体中添加一个Image控件，设置Image控件Picture属性为自定义图标的位图，并将Image控件的Visible属性设置为False，使窗体运行时隐藏Image控件，如图所示。

       在VBE中双击窗体，写入下面的代码。

1. #001  Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
   
2. #002  Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
   
3. #003  Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
4. #004  Private Const WM_SETICON = &H80
   
5. #005  Private Const ICON_SMALL = 0&
   
6. #006  Private Const ICON_BIG = 1&
   
7. #007  Sub ChangeIcon(ByVal hWnd As Long, Optional ByVal hicon As Long = 0&)
   
8. #008      SendMessage hWnd, WM_SETICON, ICON_SMALL, ByVal hicon
   
9. #009      SendMessage hWnd, WM_SETICON, ICON_BIG, ByVal hicon
   
10. #010      DrawMenuBar hWnd
    
11. #011  End Sub
    
12. #012  Private Sub UserForm_Initialize()
    
13. #013      Dim hWnd As Long
    
14. #014      hWnd = FindWindow(vbNullString, Me.Caption)
    
15. #015      Call ChangeIcon(hWnd, Image1.Picture.Handle)
    
16. #016  End Sub

复制代码

代码解析：
       窗体的初始化事件，窗体在显示时运行ChangeIcon函数，在标题栏中添加图标。
       第1行到第6行代码， API函数声明。
       第7行到第11行代码，ChangeIcon过程，用于转换图标。
       第14行代码，获得窗口句柄。
       第15行代码，运行ChangeIcon过程，将Image控件中的位图显示在窗体的标题栏上。
       运行窗体后，在窗体标题栏上添加图标，如图所示。

yuanzhuping

技巧136         用户窗体添加最大最小化按纽
       VBA中的窗体标题栏上只有关闭按纽，没有最大最小化按纽的，可以使用API函数在窗体的标题栏上添加最大最小化按纽，如下面的代码所示。

1. #001  Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
2. #002  Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   
3. #003  Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
4. #004  Private Const WS_MAXIMIZEBOX = &H10000
   
5. #005  Private Const WS_MINIMIZEBOX = &H20000
   
6. #006  Private Const GWL_STYLE = (-16)
   
7. #007  Private Sub UserForm_Initialize()
   
8. #008      Dim hWndForm As Long
   
9. #009      Dim iStyle As Long
   
10. #010      hWndForm = FindWindow("ThunderDFrame", Me.Caption)
    
11. #011      iStyle = GetWindowLong(hWndForm, GWL_STYLE)
    
12. #012      iStyle = iStyle Or WS_MINIMIZEBOX
    
13. #013      iStyle = iStyle Or WS_MAXIMIZEBOX
    
14. #014      SetWindowLong hWndForm, GWL_STYLE, iStyle
    
15. #015  End Sub

复制代码

代码解析：
       窗体初始化时使用API函数在标题栏上添加最大最小化按纽。
       第1行到第6行代码，API函数声明。
       第10行代码，获取窗口句柄。
       第11行到第14行代码，在标题栏上添加最大最小化按纽。
       运行窗体后效果如图所示。

yuanzhuping

技巧137         禁用窗体标题栏的关闭按钮
       如果不希望用户通过窗体标题栏的关闭命令来关闭窗体，可以禁用窗体标题栏上的关闭按钮，如下面的代码所示。

1. #001  Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
   
2. #002      If CloseMode <> 1 Then
   
3. #003          Cancel = True
   
4. #004          MsgBox "请点击按钮关闭窗体!"
   
5. #005      End If
   
6. #006  End Sub

复制代码

代码解析：
       窗体的QueryClose事件，禁用窗体标题栏上的关闭按钮。
       窗体的QueryClose事件发生在窗体关闭之前，语法如下：
       Private Sub UserForm_QueryClose(cancel As Integer, closemode As Integer)
       参数Cance是可选的，整数。将此参数设置成 0 以外的任意值，在所有加载的用户窗体中停止QueryClose事件，并防止关闭窗体与应用程序。
       参数closemode是可选的，一个值或常数，用来指示引起QueryClose事件的原因。
       closemode参数的设置值如表格所示。
      
       第2、3行代码，如果窗体不是由代码调用Unload语句关闭，则停止关闭过程，从而禁用窗体标题栏的关闭按钮。
       需要注意的是，一定要在窗体上设置关闭窗体的途径，否则会使窗体无法关闭。
       窗体运行后，禁用窗体上的关闭按钮关闭窗体，只能使用按钮关闭窗体，如图所示。
      

roi19741109

研究 研究！

etboy226

谢谢奉献
正需要这个，太感谢了

ayu330602

版主真是超级好人,除了讲课也不忘网友的提问,谢谢!

liuk70

提示“运行时错误'50290'，方法’OPEN作用于对象'workbooks'时失败,已解决

bipl607

good!!!!!!!!!!!!!!!!!!