超级单元格上的Excel中心屏幕

I have come up with the following macro to center the screen on the cell by following hyperlinks from one sheet to another. Unfortunately it doesn't quite work yet. any ideas on what I am doing wrong?

我已经提出了以下宏来通过跟踪从一个工作表到另一个工作表的超链接来使单元格上的屏幕居中。不幸的是它还没有完成。关于我做错什么的任何想法？

'Center screen to cell for map hyperlinks
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
'On Error Resume Next
Application.ScreenUpdating = False
Dim onCell As Range
Dim VisRows As Integer
Dim VisCols As Integer

Set onCell = Application.Evaluate(Target.SubAddress)
onCell.Parent.Parent.Activate
onCell.Parent.Activate
With ActiveWindow.VisibleRange
    VisRows = .Rows.Count
    VisCols = .Columns.Count
End With
With Application
    .Goto Reference:=onCell.Parent.Cells( _
        .WorksheetFunction.Max(1, onCell.Row + _
        (onCell.Rows.Count / 2) - (VisRows / 2)), _
        .WorksheetFunction.Max(1, onCell.Column + _
        (onCell.Columns.Count / 2) - _
        .WorksheetFunction.RoundDown((VisCols / 2), 0))), _
     scroll:=True
End With
onCell.Select

Application.ScreenUpdating = True
End Sub

Note on my target sheet I have hidden rows and columns that I am not using.

关于我的目标表的注意事项我隐藏了我不使用的行和列。

1 个解决方案

#1

Say our goal to to click on a hyperlink, jump to another cell as a result, and then position the new ActiveCell near the middle of the screen. Give this a try:

说我们的目标是单击超链接，然后跳转到另一个单元格，然后将新的ActiveCell放置在屏幕中间附近。尝试一下：

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Application.Goto reference:=ActiveCell, scroll:=True
    With ActiveWindow
        i = .VisibleRange.Rows.Count / 2
        j = .VisibleRange.Columns.Count / 2
        .SmallScroll Up:=i, ToLeft:=j
    End With
End Sub

This relies on the fact that after the jump, the active window is setup with the target at the lower-right corner. Using SmallScroll allows us to move the window about 1/2 screen down and 1/2 to the right.

这依赖于以下事实：在跳转之后，设置活动窗口，目标位于右下角。使用SmallScroll允许我们将窗口向下移动1/2屏幕，向右移动1/2。