将用户窗体移到特定的工作表单元格上

时间:2019-07-18 16:50:35

标签: excel vba userform

我正在尝试将用户表单部分移出屏幕以在下面的活动表中显示数据。单击窗体上的SpinButton,然后滚动浏览一个简短列表,突出显示需要注意的单元格。

我想将Userform.Top和.Left放在计算出的Cell.Top&.Left上,以通过移动表单来使必要的数据可见

UserForm.Move方法似乎不是正确的方法,尽管它的名称以及所有参数都以Point为单位的事实与Cell.Left和Cell.Top相同

我看过较早的S.O.答案(here,更希望是the last answer here

我现有的代码仅在需要显示工作表并返回正常的默认表示时才调用UserForm_Activate()。 [编辑]我应该提到,Activewindow可以水平和垂直偏移。这是我的代码:

Private Sub UserForm_Activate()

Dim AppXCenter As Long, AppYCenter As Long

    AppXCenter = Application.Left + (Application.Width / 2)
    AppYCenter = Application.Top + (Application.Height / 2)

    With Me
        .StartUpPosition = 0    'mode 1 not suitable when extending VBE to a 2nd monitor

        .Top = AppYCenter - (Me.Height / 2)
        .Left = AppXCenter - (Me.Width / 2)
        If .Top < 0 Then .Top = 0
        If .Left < 0 Then .Left = 0

        If UserForm_Needs_To_Move Then
            VBA.beep  'in lieu of a frustrated smiley

            'I have tried many ways to calculate the offset to the desired column
            'This is the simplest

            Me.Move [y1].Left - Me.Left

            'NONE of them work!!!                

        End If
    End With
End Sub

Private Sub UserForm_Initialize()

    'UserForm_Activate 'is presently commented out

    'the form currently appears on screen at first Activate event
    'I have tried uncommenting, but it has not helped

End Sub

我可以接近我的描述,但是不够准确。

是否需要按照参考文献2使用Lib GDI32等中的API GetDeviceCaps?

我希望代码能够在其他设备和分辨率等上工作,因为其他人会使用该应用程序。

1 个答案:

答案 0 :(得分:0)

@Matthieu-感谢您提供有用的评论和网络参考。

在您的帮助下,我现在对所有事情都更加了解了。现在,我有了一些有效的方法,并且可以发布我自己的问题的答案了。

下面的代码将用户窗体准确地重新定位在ActiveWindow中任何工作表范围内或附近。它会调整为用户的显示设置(应如此)。 我看过其他帖子在搜索这种东西,所以这里提供了一个产品。

要对其进行测试,请向新项目中添加用户窗体和标准模块 UserForm需要Label1和CommandButton1。 加载表单后,请继续按Enter-无聊。

用户表单代码

sessionInfo()

模块代码

 Option Explicit

'Private Type RECT    documentation 
'  Left                  As Long
'  Top                   As Long
'  Right                 As Long
'  Bottom                As Long
'End Type


Private Sub CommandButton1_Click()

Dim R As Long, C As Long
Dim X As Long, Y As Long
Dim i As Long, Cell As Range

'H and W are > 1 for test purposes only
Const H As Long = 3
Const W As Long = 5

    'test Randomizing starts
    'move the ActiveWindow around
    R = Int((5 * Rnd) + 1)    ' Generate random value between arg2 and arg1.
    C = Int((20 * Rnd) + 1)
    Set Cell = Cells(R, C)

    ActiveWindow.ScrollRow = R:    ActiveWindow.ScrollColumn = C

    'activate a random cell in the window
    X = Int((6 * Rnd) + 8): Y = Int((6 * Rnd) + 1)
    Cell.Offset(X, Y).Activate

    Me.Label1 = "Window at " & Cell.Address(False, False, xlA1) & ", " _
                             & Cell.Address(True, True, xlR1C1) _
               & vbLf _
               & "ActiveCell @ Window Offset " _
               & Cell.Offset(X, Y).Address(False, False, xlR1C1, , Cell)
    'randomizing ends
    ActiveCell.Resize(H, W).Select


    '====================================
    'Move the UserForm near to ActiveCell
Dim rc As RECT
    On Error GoTo done
    Call GetRangeRect(ActiveCell.Resize(H, W), rc)
done:
    Me.Top = PXtoPT(rc.Top, True)       'place form at offset(0,1)
    Me.Left = PXtoPT(rc.Right, False)
    '====================================

End Sub


Private Sub UserForm_Activate()

    Dim AppXCenter As Long, AppYCenter As Long
    AppXCenter = Application.Left + (Application.Width / 2)
    AppYCenter = Application.Top + (Application.Height / 2)

    With Me
        .StartUpPosition = 0    '- necessary if extending the VBE to a 2nd monitor
        .Top = AppYCenter - (Me.Height / 2)
        .Left = AppXCenter - (Me.Width / 2)
        If .Top < 0 Then .Top = 0
        If .Left < 0 Then .Left = 0

    End With

End Sub

Private Sub UserForm_Initialize()
    With Me.Label1
        .WordWrap = False
        .AutoSize = True
        .Left = 6
    End With
    Randomize    ' Initialize the generator.
End Sub

我只是希望这对其他人有帮助,就像Matthieu这样的人对我有所帮助。