Adjust zoom based on resolution via FollowHyperlink event

3
votes

My sheet has data in columns A to Z. I have hyperlinks in rows 13 to 49 that jump to specific cells in rows below. For example, the hyperlink in row 13 will jump to row 229.

The hyperlinks are fine until I do a presentation on another machine with a different resolution. Instead of jumping to row 229, it shows row 248.

I have tinkered with this and this but have had no success yet. Also tried this less related answer to see if I can trick excel. I have also tried the below code:

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
excelvba
You could make the links fire a function that find the data you want based on the link clicked and then do a range("A" & row).Activate – MatthewD

2 Answers

2
votes

If you are looking to put A229 into the top-left corner of the visible worksheet area, then fool Excel by first going past the visible portion of the worksheet that you want and come back to it.

In A13, put a hyperlink that goes to A1229, not 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

Note that the actual subaddress target is A1229, not A229.

Right-click the worksheet's name tab and choose View Code. When the VBE opens, paste one of the following into the worksheet code sheet titled something like 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

... or,

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

Use one or the other but not both. The former seems to have marginally less screen 'flash' on my system.

1
votes

It just hit me. Check out Windows(1).VisibleRange.Rows.count

You can see how many rows are displayed, go down so the link target will be at the top. This should be accurate regardless of the resolution.

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