制作悬浮按钮

delete_007

所谓的”悬浮按钮“指的是：不会因为页面的上下左右滚动而移出可视区域的控件。要想达到这个效果，除了使用冻结窗格的方法外，还可以使控件始终位于工作表的固定位置。
第一种方法：使用无模式的窗体。
    制作步骤：
        1.在VBE窗口中，插入用户窗体，并设置用户窗体的ShowModal属性为False。（其余美化工作可自行设置）
        2.在用户窗体上添加一个Label控件，设置控件的Back Style属性为0，Caption属性为你需要显示的名字。
        3.调整窗体和标签的位置和尺寸。
        4.双击窗体，输入如下代码。

1. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   
2. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
3. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
4. Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
   
5. Private Declare Sub ReleaseCapture Lib "user32" ()
   
6. 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
   
7. Private Const GWL_STYLE As Long = (-16)
   
8. Private Const WS_CAPTION As Long = &HC00000
   
9. Private Const WM_NCLBUTTONDOWN = &HA1
   
10. Private Const HTCAPTION = 2
    
11. 
    
12. Private Sub UserForm_Initialize()
    
13.     Dim lngStyle As Long
    
14.     Dim hWnd As Long
    
15.     hWnd = FindWindow(vbNullString, Me.Caption)
    
16.     lngStyle = GetWindowLong(hWnd, GWL_STYLE)
    
17.     SetWindowLong hWnd, GWL_STYLE, lngStyle And Not WS_CAPTION
    
18.     DrawMenuBar hWnd
    
19.     Me.Height = 31.5
    
20. End Sub
    
21. 
    
22. Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
23.     Dim hWnd As Long
    
24.     hWnd = FindWindow(vbNullString, Me.Caption)
    
25.     ReleaseCapture
    
26.     SendMessage hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
    
27. End Sub
    

复制代码

       5.在thisworkbook中添加如下代码：

1. Private Sub Workbook_Open()
   
2.     UserForm1.Show
   
3. End Sub
   

复制代码

       6.保存并关闭工作薄，当再次打开工作薄时，就会出现一个悬浮按钮。效果如下图所示（可以将按钮拖放到任意位置）：


制作悬浮按钮.rar (16.51 KB, 下载次数: 2064)

2014-9-11 11:54 上传

点击文件名下载附件

delete_007

第二种方法：API函数配合计时器

---

    制作步骤：
        1.在工作表中插入一个命令按钮。
        2.进入VBE窗口，在Thisworkbook下面添加如下代码：

1. Private Sub Workbook_beforeClose(cancel As Boolean)
   
2.     Call KillTimer(0, TimerID)
   
3. End Sub
   
4. 
   
5. Private Sub Workbook_Open()
   
6.     TimerID = SetTimer(0, 0, 100, AddressOf OnTimer)
   
7. End Sub

复制代码

       3.插入模块，添加如下代码：

1. Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
   
2. Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
   
3. Public TimerID As Long
   
4. Public Sub OnTimer()
   
5.     On Error Resume Next
   
6.     Sheet1.Shapes("Button 1").Top = ActiveWindow.VisibleRange.Top + 10
   
7.     Sheet1.Shapes("Button 1").Left = ActiveWindow.VisibleRange.Left + 10
   
8.     Sheet1.Shapes("Button 2").Top = ActiveWindow.VisibleRange.Top + 50
   
9. End Sub

复制代码

       4.保存并关闭工作薄，再次打开工作薄，即可得到悬浮按钮，效果如下图：


悬浮按钮2.rar (16.75 KB, 下载次数: 1030)

2014-9-11 12:01 上传

点击文件名下载附件

a68508122

厉害，收藏了

东亚五金

暂时用不上,收藏了

geryjun

效果不错，谢谢了。

涧中石

学习了，谢谢分享！

renahu

为什么第一种方法，进入设计模式，按钮消失了，退出设计模式，按钮还是找不到？

A0101

好东西，版主辛苦了

liumiaomiao

谢谢分享

yqdaqinqin

非常有意思，谢谢版主