我长期使用此网站查找我的问题的答案，但我无法找到有关此问题的任何内容。如果我错过任何事情，请提前道歉。
所以我有一个工作簿（Office 2013，VBA 7.1），我尝试使用userform作为菜单，它将在页面上保持静止，并随工作簿移动。我使用了来自http://www.cpearson.com/excel/SetParent.aspx的代码组合来锁定表单到窗口和http://www.oaltd.co.uk/Excel/Default.htm（FormFun.zip）以从表单中删除标题并防止它在页面上移动。
这段代码工作得很好，但是我一直遇到一个奇怪的错误，插入的表单＆＃34; .Top＆＃34;值与我在代码中指定的值不同。我还有一个同事运行代码并得到相同的问题。我将列出以下代码的相关部分。
我在模块（Module1）中有以下代码：
Sub CallFormTestA()
With UserForm1
.Show vbModal = False
.StartUpPosition = 0
.Left = 17
.Top = 147
End With
End Sub
我在UserForm（UserForm1）中有以下代码：
Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
Private Const GWL_STYLE As Long = (-16) 'The offset of a window's style
Private Const WS_CAPTION As Long = &HC00000 'Style to add a titlebar
Private Sub SetBit(ByRef lStyle As Long, ByVal lBit As Long, ByVal bOn As Boolean)
If bOn Then
lStyle = lStyle Or lBit
Else
lStyle = lStyle And Not lBit
End If
End Sub
Private Sub Userform_Initialize()
Dim MeHWnd, ApphWnd, DeskhWnd, WindowhWnd, Res, lStyle As Long
'Get the window handle of the main Excel application window.
ApphWnd = Application.hwnd
If ApphWnd > 0 Then
'Get the window handle of the Excel desktop.
DeskhWnd = FindWindowEx(ApphWnd, 0&, "XLDESK", vbNullString)
If DeskhWnd > 0 Then
'Get the window handle of the ActiveWindow.
WindowhWnd = FindWindowEx(DeskhWnd, 0&, "EXCEL7", ActiveWindow.Caption)
If WindowhWnd > 0 Then
'OK
Else
MsgBox "Unable to get the window handle of the ActiveWindow."
End If
Else
MsgBox "Unable to get the window handle of the Excel Desktop."
End If
Else
MsgBox "Unable to get the window handle of the Excel application."
End If
MeHWnd = FindWindow("ThunderDFrame", Me.Caption)
If MeHWnd = 0 Then Exit Sub
lStyle = GetWindowLong(MeHWnd, GWL_STYLE)
SetBit lStyle, WS_CAPTION, False
SetWindowLong MeHWnd, GWL_STYLE, lStyle
If (MeHWnd > 0) And (WindowhWnd > 0) Then
Res = SetParent(MeHWnd, WindowhWnd)
If Res = 0 Then
MsgBox "The call to SetParent failed."
End If
End If
End Sub
正如我所说，这段代码正确地创建了表单，但是当我运行时 msgbox userform1.top 在即时窗口中，它返回一个不同的值，在多次尝试中不一致，但通常在250-300范围内，通常小数点为.25，.5或.75。
我不太了解我使用Stephen Bullen和Chip Pearson编写的大部分代码，但它看起来不会影响userform1.top对我的价值。任何人都可以确定我使用的代码是否存在问题会改变userform1.top值吗？这可能是一个错误吗？
这是我第一次在这里提问，所以如果有任何其他信息我应该包括（或遗漏），请告诉我。
谢谢！
Edit1：根据Scott Holtzman的一些反馈，我尝试在代码中添加一些debug.print行，以便在代码的每个点识别.top的值。我的发现如下，尽管斯科特在运行时得到了不同的数字。这都包含在module1的子CallFormTestA（）中。我还发现，如果我第二次运行模块而不重置项目，我会得到不同的结果。如果我在第二次之后再次运行模块，它会保持第二次得到的相同结果。
With UserForm1
Debug.Print .Top 'Returns 139.5 then 286.5
.Show vbModal = False
.StartUpPosition = 0
.Left = 17
.Top = 147
Debug.Print .Top 'Returns 286.5 then 286.5
End With
With UserForm1
Debug.Print .Top '139.5 then 286.5
.Show vbModal = False
.StartUpPosition = 0
.Left = 17
.Top = .Top - .Top 'Changed
Debug.Print .Top '139.5 then 139.5
.Top = 147
Debug.Print .Top '286.5 then 286.5
End With
With UserForm1
Debug.Print .Top 'Returns 139.5 then 286.5
.Show vbModal = False
.StartUpPosition = 0
.Left = 17
.Top = -.Top 'Changed
Debug.Print .Top 'Returns -372 then -147
.Top = 147
Debug.Print .Top 'Returns 286.5 then 286.5
End With
With UserForm1
Debug.Print .Top '139.5 then 286.5
.Show vbModal = False
.StartUpPosition = 0
.Left = 17
.Top = Abs(-.Top) 'Changed
Debug.Print .Top '511.5 then 286.5
.Top = 147
Debug.Print .Top '286.5 then 286.5
End With
With UserForm1
Debug.Print .Top '286.5 then 286.5
.Show vbModal = False
.StartUpPosition = 0
.Left = 17
.Top = 0 'Changed
Debug.Print .Top '139.5 then 139.5
.Top = 147
Debug.Print .Top '286.5 then 286.5
End With
Dim n As Long 'Tried using an integer to store the .top value
With UserForm1
Debug.Print .Top '139.5 then 286.5
.Show vbModal = False
.StartUpPosition = 0
.Left = 17
n = .Top 'This drops the decimal, but I don't care about that.
Debug.Print .Top & ", " & n '511.5, 512 then 286.5, 286
.Top = .Top - n
Debug.Print .Top '138.75 then 140.25
.Top = 147
Debug.Print .Top '286.5 then 286.5
End With
Edit2：我已经做了更多的游戏，特别是隔离了代码的某些部分。我发现如果我从UserForm1代码中注释掉以下行，则.Top属性设置正确。
If (MeHWnd > 0) And (WindowhWnd > 0) Then
Res = SetParent(MeHWnd, WindowhWnd)
If Res = 0 Then
MsgBox "The call to SetParent failed."
End If
End If
为了澄清，这里重复了SetParent函数：
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
我仍然没有看到这些行如何影响form.top属性，但我无法弄清楚问题可能出在哪里。我将继续研究这个问题，但是如果有人正在研究这个问题，我想更新一下。
Edit3：我能够与这段代码搏斗并最终让它做我想做的事，但我仍然不知道为什么。我发布了我的更新代码作为答案，但如果有人能够提供更多有关此处发生的事情的见解，我将非常感谢您的投入。
答案 0 :(得分：1)
Dasmittel，我似乎正在走正确的道路（尽管4年后），并且想知道您在那段时间是否取得了进展？作为记录，我已经在您的示例案例中使用过Excel 2007和（当前）Excel 2013中的此问题。
我还使用Chip Pearson代码（我在上面认识到）使userform成为工作表的子级。像您一样，我还确定SetParent调用正在提高定位。
'<=== Form IS correctly positioned here
Res = SetParent(hWndChild:=ChildHWnd, hWndNewParent:=ParentHWnd)
'<=== Form is NOT correctly positioned here
设置/更改用户窗体的父级也是导致相对于给定单元格定位用户窗体的各种解决方案不起作用的原因。这是由于：
我相信在这两者之间的解释是分配.Left或.Top会给出如下结果：
.Left = 10: '--> Debug.Print .Left = 149
我不明白的是为什么设置.Left 也会改变 .Top（同样设置.Top 也改变 .Left）？!!
但是，我认为，我的结果似乎与您的结果略有不同。是的，您可以将其标记为XMod和YMod。电子表格的启动位置（可能还有电子表格的大小？）似乎会影响这些值。但是无论打开工作表时是什么，它们都保持不变，并且...
我认为这是Excel中的错误。我希望以一种方式或另一种方式进行澄清。
我从一个似乎在最初定位时就可以工作的人那里得到了帮助，现在我明白了：
[1] https://drive.google.com/file/d/1smHLeNLy8w23YnRgZmQtaMCp_kJzpM72/view?usp=sharing
我最初冻结了工作簿的第2行，以使我的列标题可见。不幸的是，正如Chip Pearson和其他处理此问题的人所指出的那样，冻结窗格进一步使问题变得更加复杂，并且我再次得到不一致的结果。我当前的想法是，与分配用户窗体的位置时哪个窗格处于活动状态有关。现在，我不冻结任何行/列。如果我可以在冻结窗格中使用它，我也将在此处添加该解决方案。
希望对原始海报或其他人有所帮助，这是我当前的代码库，用于在A1 AFTER 单元格上方放置用户表单（不冻结窗格）并将其父级设置为工作表。
请注意，在此示例中，我使用MyUserForm作为用户窗体的名称。您可以将对PositionUserForm的调用更改为反映用户表单的名称。这是代码。
这进入一个模块：
Declarations
Private Type POINTAPI
x As Long
y As Long
End Type
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare PtrSafe Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function SetParent Lib "user32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare PtrSafe Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
#Else
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongLong
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As LongLong
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As LongLong
Private Declare PtrSafe Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As LongLong
Private Declare PtrSafe Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As LongLong
Private Declare PtrSafe Function SetParent Lib "user32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As LongLong
Private Declare PtrSafe Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongLong
Private Declare PtrSafe Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As LongLong
#End If
Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
#Else
Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function SetParent Lib "user32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
#End If
Public Sub PositionUserForm(Target As Range, frm As UserForm)
Const SWP_NOSIZE = &H1
Const SW_SHOW = 5
Dim pt As POINTAPI
Dim OffsetX As Long
Dim OffsetY As Long
Dim EXCEL7Hwnd As Long
Dim UserFormHwnd As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' *Should* be the screen coords of the leftmost, visible range
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
OffsetX = ActiveWindow.PointsToScreenPixelsX(0)
OffsetY = ActiveWindow.PointsToScreenPixelsY(0)
pt.x = OffsetX + PointsToPixels(ActiveWindow.PointsToScreenPixelsX(Target.Left) - OffsetX, "X")
pt.y = OffsetY + PointsToPixels(ActiveWindow.PointsToScreenPixelsY(Target.Top) - OffsetY, "Y")
WindowFromAccessibleObject frm, UserFormHWnd
EXCEL7Hwnd = FindWindowEx(FindWindowEx(Application.hwnd, 0, "XLDESK", vbNullString), 0, "EXCEL7", vbNullString)
SetParent UserFormHwnd, EXCEL7Hwnd
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Note: In simple terms, the userform does not scroll with the worksheet. So you need to be
' sure that the cell you are using to position the userform is physically (in regards to
' Excel) positioned where the userform needs to be placed. Failure to do so, will result
' in an incorrectly placed (and possibly "invisible") userform.
'
' In a little more detail, the coords used in this subroutine are based upon a "virtual"
' desktop that extends beyond the Excel window. The *initial* location of the cell used
' for positioning upon this virtual desktop is critical. If the "home" cell is off the
' visible screen when the userform is positioned, the userform will be "visible" but
' permanently off screen until the appropriate .left or .top property is corrected.
'
' Personally, I place the userform over cell A1 and want the userform to cover the top/
' leftmost corner of usable window/area of the worksheet.
'
' If row 1 is scrolled off the top of the screen, pt.x will be negative.
' If column A is scrolled off the left of the screen, pt.y will be negative.
' In either case, your userform will be "Visible" but placed OUTSIDE of the visible window.
'
' A1 can neither be scrolled off the bottom or right the screen. However should you use a
' different cell, then that cell *could* be scrolled down and/or right which would result
' in an incorrectly larger positive value for .left and/or .top and possibly therefore an
' incorrectly placed userform. Should the number be large enough, the userform, though
' "visible" would be permanently placed oustide of the visible window.
'
' Should your userform be displayed outside of the visible screen, you will want to correct
' its position by adjusting .left or .top. Know that after having been made a child of the
' workbook, the userform's .left and .top will no longer work as expected (the very reason
' this routine is needed to properly place it). This is because .left and .top are based
' upon SCREEN positioning while after being made a child, the userform's .top and .left are
' based upon the Excel window's posititon AND also use a different unit of measure than
' previously.
'
' Additionally, note that after making the userform a child of the workbook, changing
' either of these two properties also changes *the other*?!! This seems to be an error
' in Excel (I am using Excel 2013) as noted in a previous post in this thread. If the userform
' is off screen, you can change either .Left or .Top. Once the userform appears on screen,
' drag it to where you want with the mouse.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Translate screen coords to client (new parent) coords
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ScreenToClient EXCEL7Hwnd, pt
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SWP_NOSIZE tells the function to ignore the height and width args
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SetWindowPos UserFormHwnd, 0, pt.x, pt.y, 0, 0, SWP_NOSIZE
ShowWindow UserFormHwnd, SW_SHOW
End Sub
Private Function PointsToPixels(Pts As Double, Axis As String) As Long
Const WU_LOGPIXELSX = 88
Const WU_LOGPIXELSY = 90
Dim hdc As Long
hdc = GetDC(0)
PointsToPixels = (Pts / (72 / GetDeviceCaps(hdc, IIf(Axis = "X", WU_LOGPIXELSX, WU_LOGPIXELSY)))) * (ActiveWindow.Zoom / 100)
ReleaseDC 0, hdc
End Function
Public Sub GotoHomeCell
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' I am showing my low level of vba programming skills with this subroutine's method of
' being certain that the correct worksheet is active and that cell A1 is top/left
' so that the userform is correctly situated. I tried various ways and was not happy
' with the results. This while surely not optimal seems to work. I'd love a better
' solution should someone want to correct this.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Be sure A1 is displayed on screen
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sheets("GameDev").Activate
ActiveSheet.Range("A1").Select 'Goto ActiveCell did not seem to work without EntireRow but...
Application.Goto ActiveCell.EntireRow, True 'Leaves entire row selected so... next line...
ActiveSheet.Range("A1").Select
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Display userform in correct position
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Call PositionUserForm(Range("A1"), MyUserForm) '< Set flag? In theory, only need to execute PositionUserForm ONCE?
End Sub
此行进入用户窗体的UserForm_Initialize：
Call GotoHomeCell
请注意，我拨打了GotoHomeCell
答案 1 :(得分：0)
我仍然不明白这里发生的事情的全部内容，但我想我应该发布这个答案，以防未来的某些人有类似的问题。
正如我在第二次编辑中发现的那样，所有这一切的关键是SetParent函数：
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
这导致Excel添加一个特定的值，比如说XMod（可能因用户和硬件而异）到表单的.top属性，还有另一个值YMod到.left属性，我没有'在这种情况下看。最后，如果我将.top和.left都设置为0，XMod和YMod将导致表单出现，表单的顶部与列标题的顶部对齐，并且表单的左侧与行标题的左侧。我设置的任何数字都将为最终结果添加适当的修饰符。但是这个数字通常会有一个很小的变化，以便与屏幕分辨率保持一致，这就是为什么我最初认为它是随机的。
然而，这确实引入了另一个问题，因为每当我设置.top或.left时，Excel都会将修改器添加到.top和.left。意思是，如果我有以下代码：
With UserForm1
.Show vbModal = False
.StartUpPosition = 0
.Left = 17
.Top = 147
End With
Excel将设置.top = YMod + 147和.left = XMod + XMod + 17。在我的初始代码中，XMod是0，所以我没有注意到它添加了两次。我通过将变量设置为YMod来解决这个问题，然后在稍后设置.Top时减去该变量，如下所示：
With Navigation
.Top = 0
t = .Top
.Show vbModal = False
.StartUpPosition = 0
.Top = 13 - t
.Left = 19
End With
这给了我正确的结果。如果其他人有任何问题让这个工作，我希望这将有所帮助。如果我能看到其他人以更有意义的方式回答问题，我肯定会将他们的问题标记为答案。