vba - UserForm.Top 值从已分配更改

Question

我长期以来一直使用这个网站来寻找我的问题的答案，但我找不到关于这个问题的任何信息。如果我错过了什么，请提前道歉。

所以我有一个工作簿(Office 2013，VBA 7.1)，我试图将用户窗体用作菜单，该菜单将在页面上保持静止并随工作簿移动。我使用了 http://www.cpearson.com/excel/SetParent.aspx 中的代码组合将表单锁定到窗口和http://www.oaltd.co.uk/Excel/Default.htm (FormFun.zip)从表单中删除标题并防止它在页面上移动。

此代码运行良好，但我一直遇到一个奇怪的错误，其中插入的表单“.Top”值与我在代码中分配的值不同。我也让一位同事运行代码并遇到同样的问题。我将在下面列出代码的相关部分。

我在模块(Module1)中有以下代码:

Sub CallFormTestA()

With UserForm1
   .Show vbModal = False
   .StartUpPosition = 0
   .Left = 17
   .Top = 147
   End With

End Sub

我在用户窗体(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 的范围内，通常小数点为 0.25、0.5 或 0.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:我能够与这段代码搏斗并最终让它做我想做的事，但我仍然不知道为什么。我发布了我更新的代码作为答案，但如果有人可以提供更多关于这里发生的事情的见解，我将非常感谢您的输入。

Answer 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

设置/更改用户窗体的父级也是使用户窗体相对于给定单元格定位的各种解决方案不起作用的原因。这是因为:

引用点从屏幕的 0,0 变为
应用程序的。所以 Left = 20 之后必然会有所不同
设置用户窗体的父级。

(如果我对此有误，请随时纠正我)使用了不同的计量单位。

我相信这两者之间是分配 .Left 或 .Top 给出如下结果的解释:

.Left = 10:  '--> Debug.Print .Left = 149

我不明白的是为什么设置.Left也会改变.Top(同样设置.Top也会改变.Left)？!
但是，我认为我的结果似乎与您的结果略有不同。是的，有你标记的 XMod 和 YMod。电子表格的启动位置(可能还有电子表格的大小？)似乎会影响这些值。但是无论打开工作表时它们是什么，它们都会保持不变并且......

x 到 .left 的每次更改似乎都是这样做的: .left = x + XMod 和 .top = .top + YMOD

y 到 .top 的每次更改似乎都是这样做的: .top = y + YMod 和 .left = .left + XMOD

我认为这是 Excel 中的错误。不过，我希望以一种或另一种方式进行澄清。
我从一个似乎在初始定位工作的人那里得到了帮助，现在我得到了这个:
[1] https://drive.google.com/file/d/1smHLeNLy8w23YnRgZmQtaMCp_kJzpM72/view?usp=sharing
我最初将工作簿卡住在第 2 行以保持我的列标题可见。不幸的是，正如 Chip Pearson 和其他处理此问题的人所指出的那样，卡住 Pane 使问题进一步复杂化，我再次得到不一致的结果。我目前的想法是，它与分配用户窗体的位置时哪个 Pane 处于事件状态有关。目前，我没有卡住任何行/列。如果我曾经在卡住 Pane 中使用此解决方案，我也会在此处添加该解决方案。
希望它对原始海报或其他人有所帮助，这是我当前的代码库，用于在单元格 A1 上放置用户表单(没有卡住 Pane )之后 将其父级设置为工作表。
请注意，我在此示例中使用 MyUserForm 作为用户窗体的名称。您将更改对 PositionUserForm 的调用以反射(reflect)您的用户窗体的名称。这是代码。
这进入一个模块:

    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

在使用户窗体成为工作表的子级的代码之后。

经过代码隐藏菜单栏。显然，如果您不想隐藏菜单栏，这将是没有意义的。