Es gibt m.W. auch kein Ereignis, das auf Scrollen reagiert.
Da fällt mir ein, wenn es kein Ereignis gibt, dann muss man sich halt eins schreiben. Wenn du folgenden Code in ein allgemeines Modul kopierst, würde das von dir gewünschte gehen. Beim Scrollen würde die Position des Bildes angepasst, sodass es effektiv immer an der gleichen Position im Bildschirmausschnitt bleibt. Aber Achtung: Ein Fehler im Code und der Timer lässt sich nicht mehr zurücksetzen oder Excel schmiert ab. Deshalb schlage ich diese Möglichkeit nur ungern vor. Schalte unbedingt den Timer aus bevor du Änderungen am Code vornimmst. Dazu einfach das Makro TimerOff ausführen.
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Private hEvent As LongPtr
Private ScrollRow As Long
Private ScrollColumn As Long
Private VersatzTop As Single
Private VersatzLeft As Single
Public Sub TimerOn()
If hEvent <> 0 Then Exit Sub
hEvent = SetTimer(0, 0, 200, AddressOf CheckScrollEvent)
End Sub
Public Sub TimerOff()
If hEvent = 0 Then Exit Sub
KillTimer 0, hEvent
End Sub
Public Sub CheckScrollEvent(ByVal hWnd As LongPtr, ByVal uMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr)
On Error Resume Next
If ActiveWorkbook.Name = ThisWorkbook.Name And ActiveSheet.Name = Worksheets("Tabelle1") Then
If ScrollRow = 0 And ScrollColumn = 0 Then
VersatzTop = ActiveSheet.Shapes(1).Top
VersatzLeft = ActiveSheet.Shapes(1).Left
End If
If ActiveWindow.ScrollRow <> ScrollRow Or ActiveWindow.ScrollColumn <> ScrollColumn Then
ActiveSheet.Shapes(1).Left = ActiveWindow.VisibleRange.Cells(1).Left + VersatzLeft
ActiveSheet.Shapes(1).Top = ActiveWindow.VisibleRange.Cells(1).Top + VersatzTop
ScrollRow = ActiveWindow.ScrollRow
ScrollColumn = ActiveWindow.ScrollColumn
End If
End If
End Sub
Den Code musst du noch an deine Bedürfnisse anpassen. Statt Shapes(1) natürlich Shapes("Grafik 1") und statt Tabelle1 den Namen deines Tabellenblatts.
Damit der Timer Startet musst du natürlich TimerOn ausführen. Das kannst du z.B. über das Workbook_Open Event im Modul "DieseArbeitsmappe" machen. Dann wird der Timer beim Öffnen der Datei automatisch gesetzt und das Event startet.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
TimerOff
End Sub
Private Sub Workbook_Open()
TimerOn
End Sub
Gruß Mr. K.
