Addin Applikationsweit nutzen!

Der Code eines Addin soll Applikationsweit zur Verfügung stehen also auch noch, wenn "Datei - Neu..." ausgeführt wird. Hier mal an einem Beispiel in dem abhängig vom Zoom und der Bildschirmauflösung bei erreichen einer bestimmten Zelle diese automatisch nach oben gescrollt wird. Mit den Funktionstasten F5 / F6 kann die Funktion ein- bzw. ausgeschaltet werden. Ist jetzt exemplarisch nur für Auflösung "1280 x 1024" und "1024 x 768". Weitere Auflösungen, Zoom bzw. andere Einschränkungen können natürlich nach belieben angepasst werden. :-)

Klassenmodul, Scrollen mit Zoom und Auflösung... [ZIP, 90 KB]

Code gehört in "DieseArbeitsmappe"

Option Explicit 
Private Sub Workbook_Open() 
    Application.OnKey "{F5}", "Application_Ereignis.An" 
    Application.OnKey "{F6}", "Application_Ereignis.Aus" 
    Call An 
End Sub 
Private Sub Workbook_Deactivate() 
    Application.OnKey "{F5}" 
    Application.OnKey "{F6}" 
    Call Aus 
End Sub 

Code gehört in ein allgemeines Modul mit Namen "Application_Ereignis"

Option Explicit 
Option Private Module 
Private Declare Function GetDeviceCaps Lib "GDI32" _
    (ByVal hdc As Long, ByVal nIndex As Long) As Long 
Private Declare Function GetDC Lib "User32" _
    (ByVal hWnd As Long) As Long 
Private Declare Function ReleaseDC Lib "User32" _
    (ByVal hWnd As Long, ByVal hdc As Long) As Long 
Private Declare Sub ShowWindow Lib "User32" _
    (ByVal hWnd As Long, ByVal nCmdShow As Long) 
Const HORZRES = 8 
Const VERTRES = 10 
Dim AppObject As New clsDatei 
Function GetScreenRes() 
    Dim lRval As Long 
    Dim lDC As Long 
    Dim lHSize As Long 
    Dim lVSize As Long 
    lDC = GetDC(0&) 
    lHSize = GetDeviceCaps(lDC, HORZRES) 
    lVSize = GetDeviceCaps(lDC, VERTRES) 
    lRval = ReleaseDC(0, lDC) 
    GetScreenRes = lHSize & "x" & lVSize 
End Function 
Public Sub An() 
    Set AppObject.AppLiCa = Application 
End Sub 
Public Sub Aus() 
    Set AppObject.AppLiCa = Nothing 
End Sub 

Code gehört in ein Klassenmodul mit Namen "clsDatei"

Option Explicit 
Public WithEvents AppLiCa As Application 
Private Sub AppLiCa_SheetSelectionChange(ByVal Sh As Object, _
    ByVal Target As Range) 
    Select Case GetScreenRes 
        Case "1280x1024" 
        Select Case ActiveWindow.Zoom 
            Case 200 
                If Target.Row Mod 18 = 0 Then 
                    Application.Goto _
                        Reference:=Range(Target.Address), _
                        Scroll:=True 
                End If 
            Case 100 
                If Target.Row Mod 38 = 0 Then 
                    Application.Goto _
                        Reference:=Range(Target.Address), _
                        Scroll:=True 
                End If 
            Case 70 
                If Target.Row Mod 55 = 0 Then 
                    Application.Goto _
                        Reference:=Range(Target.Address), _
                        Scroll:=True 
                End If 
            Case 50 
                If Target.Row Mod 77 = 0 Then 
                    Application.Goto _
                        Reference:=Range(Target.Address), _
                        Scroll:=True 
                End If 
        End Select 
        Case "1024x768" 
        Select Case ActiveWindow.Zoom 
            Case 200 
                If Target.Row Mod 16 = 0 Then 
                    Application.Goto _
                        Reference:=Range(Target.Address), _
                        Scroll:=True 
                End If 
            Case 100 
                If Target.Row Mod 33 = 0 Then 
                    Application.Goto _
                        Reference:=Range(Target.Address), _
                        Scroll:=True 
                End If 
            Case 75 
                If Target.Row Mod 43 = 0 Then 
                    Application.Goto _
                        Reference:=Range(Target.Address), _
                        Scroll:=True 
                End If 
            Case 50 
                If Target.Row Mod 63 = 0 Then 
                    Application.Goto _
                        Reference:=Range(Target.Address), _
                        Scroll:=True 
                End If 
        End Select 
    End Select 
End Sub