通过FollowHyperlink事件根据分辨率调整缩放

时间:2015-12-02 23:46:07

标签: excel-vba vba excel

我的工作表在A到Z列中有数据。我在第13到49行中有超链接,跳转到下面行中的特定单元格。例如,第13行中的超链接将跳转到第229行。

超链接很好,直到我在具有不同分辨率的另一台机器上进行演示。它不是跳到第229行,而是显示第248行。

我对thisthis进行了修改但尚未成功。还尝试了这个less related答案,看看我是否可以欺骗excel。我也尝试过以下代码:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
r = ActiveCell.Row
Range(Cells(r, 1), Cells(r, 26)).Select
'Target.Range.Select
ActiveWindow.Zoom = True

2 个答案:

答案 0 :(得分:2)

如果您希望将A229放入可见工作表区域的左上角,请首先浏览所需工作表的可见部分,然后返回到它,从而欺骗Excel。

在A13中,放置一个超链接,转到A1229,而不是A229。

Sub setup_Hyperlinks()
    With Worksheets("Sheet1")
        With .Range("A13")
            .Hyperlinks.Delete
            .Hyperlinks.Add Anchor:=.Cells(1), Address:="", SubAddress:="Sheet1!A1229", _
                            ScreenTip:="Jump to row 229", TextToDisplay:="Row 229"
        End With
    End With
End Sub

请注意,实际的子地址目标是A1229,而不是A229

右键单击工作表的名称标签,然后选择查看代码。当VBE打开时,将以下一个粘贴到工作表代码表中,标题为 Book1 - Sheet1(Code)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells(1, 1).Row > 1000 Then  'this will depend on how you craft the method for your own purposes
        Application.Goto _
          Reference:=Target.Cells(1, 1).Offset(-1000, 0)
        '[optional] move one row down for personal aesthetics
        'ActiveWindow.SmallScroll Down:=-1
    End If
End Sub

......或,

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    If ActiveCell.Row > 1000 Then  'this will depend on how you craft the method for your own purposes
        Application.Goto _
          Reference:=ActiveCell.Offset(-1000, 0)
        '[optional] move one row down for personal aesthetics
        'ActiveWindow.SmallScroll Down:=-1
    End If
End Sub

使用其中一个但不是两个。前者似乎在我的系统上略微减少了屏幕'闪光'。

答案 1 :(得分:1)

它只是打击了我。查看Windows(1).VisibleRange.Rows.count

您可以看到显示的行数,向下移动以使链接目标位于顶部。无论分辨率如何,这都应该是准确的。

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Dim iActive As Integer
    Dim lBottom As Long
    Dim ws As Excel.Worksheet

    Set ws = ActiveWorkbook.Sheets("Sheet1")

    'Get the number of rows showing
    iActive = Windows(1).VisibleRange.Rows.count

    'Move to center of the active window
    lBottom = ActiveCell.Row + (iActive / 2) - 1
    ws.Range("A" & lBottom).Activate

End Sub