VBA窗体跟随活动单元格【简易版】

本篇博客与以往的风格不同，先上图再讲解。

这个效果是不是很酷，VBA窗体（即UserForm，下文中简称为窗体）可以实现很多功能，例如：用户输入数据，提供选项等等。如本博客标题标注，这里将要实现的一个简易版，代码行数少，容易理解，便于大家移植，但是其适用场景有局限性，如果希望完美实现，那么就需要适用Windows API来精确定位。

先讲解一下代码框架。

' -- 普通（标准）模块代码 --
Public bShow As Boolean

' -- ThisWorkbook 模块代码 --
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If bShow Then Unload UserForm1
End Sub

' -- 工作表模块代码 --
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' 调整窗体显示位置实现跟随效果
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13

代码解析：
普通模块中定义共有变量bShow用于保存窗体状态。
工作簿模块中Workbook_BeforeClose事件代码在工作簿关闭时被激活，如果窗体已经被加载，那么Unload UserForm1将销毁窗体。
工作表模块中Worksheet_SelectionChange事件代码用于根据活动单元格调整窗体显示位置实现跟随效果。

---

先思考一下代码逻辑，窗体跟随其实就是根据活动单元格调整窗体的Top和Left，单元格是Range对象，也具有Top和Left属性，使用Worksheet_SelectionChange事件代码应该就可以吧。

示例代码如下。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim frm
    If Not bShow Then UserForm1.Show 0
    Set frm = UserForm1
    With Target
        frm.Top = .Top
        frm.Left = .Left + .Width
    End With
End Sub
1
2
3
4
5
6
7
8
9

测试一下效果。

这是什么鬼！窗体为什么出现在一个不着边际的地方，在立即窗口中查看一下B1单元格的相关属性。

?[b1].top
0
?[b1].left
52.8

单元格的这两个属性返回值是相对于工作表中表格区域左上角的偏移量，然而窗体的相对于屏幕左上角的偏移量，Excel的功能区高度是固定的，那么加个固定偏移量就可以了。

示例代码如下。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim frm
    If Not bShow Then UserForm1.Show 0
    Set frm = UserForm1
    With Target
        frm.Top = .Top + 180
        frm.Left = .Left + .Width + 19
    End With
End Sub
1
2
3
4
5
6
7
8
9

so easy 轻松实现了窗体跟随效果。

注意：针对不同版本的Excel，这个偏移量可能并不相同，

滚动屏幕，发现窗体又双叒叕溜号 …

继续排障大法，立即窗口中查看单元格B7的Top属性，明明是第一行，其结果竟然是97.2。看来这个偏移量是相对于整个表格区域坐上角，并非可见区域。

?[b7].top
97.2

查看VBA对象模型，Application.Windows(1).VisibleRange是工作表的可见单元格区域，利用这个Range对象，就可以实现真正的窗体跟随效果。代码中增加了限制条件，只有选中B列单元格才显示窗体，各位同学可以根据实际需要修改限制条件。

优化代码如下。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim frm, TopOffset As Single, LeftOffset As Single
    TopOffset = 180
    LeftOffset = 19
    If Not bShow Then UserForm1.Show 0
    Set frm = UserForm1
    With Target
        If .Column = 2 Then
            frm.Show 0
            frm.Top = .Top + TopOffset - Application.Windows(1).VisibleRange(1).Top
            frm.Left = .Left + .Width + LeftOffset
        Else
            frm.Hide
        End If
    End With
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

注意：本示例代码仅适用于Excel全屏显示时，如果Excel处于其他显示状态，窗体会出现偏移。