VBA如何在单元格下正确显示UserForm？

我想在放置在单元格中的button下方显示UserForm，以便它可以模拟某个popup窗口（就像下拉列表一样）。

我通过networking尝试了很多解决scheme，但都没有成功。 主要的问题是我无法获得表单元格或button的绝对屏幕位置。

Answer 1

你会用这个逻辑：

Sub SO() With UserForm1 .StartUpPosition = 0 .Top = Application.Top + (ActiveSheet.Shapes(Application.Caller).Top + 170) .Left = Application.Left + (ActiveSheet.Shapes(Application.Caller).Left + 25) .Show End With End Sub 

你的button会调用子SO()

Answer 2

如果您冻结某些行和列，此修改将使其与窗格一起使用：

 Public Sub FormShow(ByVal objForm As Object, ByVal Rng As Range) Dim L As Single, T As Single If ActiveWindow.FreezePanes Then L = ActiveWindow.Panes(GetPanesIndex(Rng)).PointsToScreenPixelsX(Rng.Left) T = ActiveWindow.Panes(GetPanesIndex(Rng)).PointsToScreenPixelsY(Rng.Top + Rng.Height) Else L = ActiveWindow.ActivePane.PointsToScreenPixelsX(Rng.Left) T = ActiveWindow.ActivePane.PointsToScreenPixelsY(Rng.Top + Rng.Height) End If ConvertPixelsToPoints L, T With objForm .StartUpPosition = 0 .Left = L .Top = T .Show End With End Sub Function GetPanesIndex(ByVal Rng As Range) As Integer Dim sr As Long: sr = ActiveWindow.SplitRow Dim sc As Long: sc = ActiveWindow.SplitColumn Dim r As Long: r = Rng.Row Dim c As Long: c = Rng.Column Dim Index As Integer: Index = 1 Select Case True Case sr = 0 And sc = 0: Index = 1 Case sr = 0 And sc > 0 And c > sc: Index = 2 Case sr > 0 And sc = 0 And r > sr: Index = 2 Case sr > 0 And sc > 0 And r > sr: If c > sc Then Index = 4 Else Index = 3 Case sr > 0 And sc > 0 And c > sc: If r > sr Then Index = 4 Else Index = 2 End Select GetPanesIndex = Index End Function Private Sub Worksheet_SelectionChange(ByVal Target As Range) FormShow UserForm1, Target SetForegroundWindow (Application.hWnd) ' aktivates Application window ' so Cellselection by key is possible ' -> Userform moves with Arrow keys not only mouse selection End Sub 

Answer 3

试试这个新的模块：

 Option Explicit Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hDC As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" ( _ ByVal hDC As Long, _ ByVal nIndex As Long) As Long Const LOGPIXELSX = 88 Const LOGPIXELSY = 90 Const TWIPSPERINCH = 1440 Sub ConvertPixelsToPoints(ByRef x As Single, ByRef y As Single) Dim hDC As Long Dim RetVal As Long Dim XPixelsPerInch As Long Dim YPixelsPerInch As Long hDC = GetDC(0) XPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSX) YPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSY) RetVal = ReleaseDC(0, hDC) x = x * TWIPSPERINCH / 20 / XPixelsPerInch y = y * TWIPSPERINCH / 20 / YPixelsPerInch End Sub Sub FormShow(ByVal objForm As Object, ByVal Rng As Range) Dim L As Single, T As Single L = ActiveWindow.ActivePane.PointsToScreenPixelsX(Rng.Left) T = ActiveWindow.ActivePane.PointsToScreenPixelsY(Rng.Top + Rng.Height) ConvertPixelsToPoints L, T With objForm .StartUpPosition = 0 .Left = L .Top = T .Show End With End Sub Sub test() FormShow UserForm1, ActiveCell End Sub 

要testing它，添加BeforeRightClick事件：

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) FormShow UserForm1, Target Cancel = True End Sub 

现在，如果您Right Click此工作表中的任何单元格， UserForm1将显示在此单元格下。

笔记：

• 这不会在RightToLeft工作表上工作，我没有成功。
• 我在这里find了ConvertPixelsToPoints。