根據分辨率通過FollowHyperlink事件調整縮放比例

Question

我的工作表具有列A到Z中的數據。我在第13到49行中有超級鏈接，它們跳到下面行中的特定單元格。例如，第13行的超鏈接將跳轉到第229行。

超鏈接沒有問題，直到我在另一臺具有不同分辨率的計算機上進行演示文稿爲止。它不是跳到第229行，它顯示第248行。

我修了this和this，但沒有成功。也試過這個less related的答案，看看我是否可以狡猾擅長。我也曾嘗試下面的代碼：

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 

Answer 1

如果您正在尋找把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 

使用一個或另一個但不是兩者。前者似乎在我的系統上的屏幕「閃光」稍微少一些。

Answer 2

它只是打我。退房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