VBA技巧之userform窗体跟随单元格显示 API应用

有些情况我们需要在excel表中显示窗体在当前单元格的附近,或者就直接跟随单元格显示,需要我们点击单元格后窗体跟着移动位置,首先想到的是

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    UserForm1.Left = Target.Left

    UserForm1.Top = Target.Top

End Sub

这段代码

但是显然运行后结果是不对的

还是万能的百度了 找到了下面的代码

利用系统api可以做到跟随单元格

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, _
        ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim lHwnd As Long
    Dim lDC As Long
    Dim lCaps As Long
    Dim lngLeft As Long
    Dim lngTop As Long
    Dim sngPiexlToPiont As Single
    Const lLogPixelsX = 88
    lDC = GetDC(0)
    lCaps = GetDeviceCaps(lDC, lLogPixelsX)
    sngPiexlToPiont = 72 / lCaps * (100 / ActiveWindow.Zoom)
    lngLeft = CLng(ActiveWindow.PointsToScreenPixelsX(0) + (Target.Offset(1, 0).Left / sngPiexlToPiont))
    lngTop = CLng(ActiveWindow.PointsToScreenPixelsY(0) + (Target.Offset(1, 0).Top / sngPiexlToPiont))
    UserForm1.StartUpPosition = 0
    lHwnd = FindWindow(vbNullString, UserForm1.Caption)
    MoveWindow lHwnd, lngLeft, lngTop, 240, 180, True
    UserForm1.Show 0
End Sub

这个代码还有缺陷，他不兼容64位office，我又升级版的代码和更好的使用技巧，请参考我的 Excel vba175例视频教学专栏

https://item.taobao.com/item.htm?id=597656284129