Ein bischen was geht immer...;-)
22.03.2009 08:53:34
ransi
HAllo
Scroll löst kein Ereigniss aus, das stimmt, aber dann man kann sich ja eins schreiben ;-)
Hier mal ein Ansatz:
(Mit der gaaaanz heißen Nadel gestrickt)
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "Tabelle1" Then
Call Aufruf
Else:
Call stoppen
End If
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Dim Z As Long
Dim S As Integer
Dim hEvent
Private Declare Function SetTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
Public Sub Aufruf()
Z = ActiveWindow.VisibleRange.Rows(1).Row
S = ActiveWindow.VisibleRange.Columns(1).Column
EnableTimer 100 'Millisekunden
End Sub
Public Sub stoppen()
DisableTimer
End Sub
Public Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long)
If ActiveWindow.VisibleRange.Rows(1).Row <> Z Then
Z = ActiveWindow.VisibleRange.Rows(1).Row
Call vertikal_Scroll
End If
If ActiveWindow.VisibleRange.Columns(1).Column <> S Then
S = ActiveWindow.VisibleRange.Columns(1).Column
Call Horizontal_Scroll
End If
End Sub
Public Function EnableTimer(ByVal msInterval As Long)
If hEvent <> 0 Then Exit Function
hEvent = SetTimer(0&, 0&, msInterval, AddressOf TimerProc)
End Function
Public Function DisableTimer()
If hEvent = 0 Then Exit Function
KillTimer 0&, hEvent
hEvent = 0
End Function
Public Sub Horizontal_Scroll()
MsgBox "Jetzt wird horizontal gescrollt"
End Sub
Public Sub vertikal_Scroll()
MsgBox "Jetzt wird vertikal gescrollt"
End Sub
ransiHAllo
Hier mal ein Ansatz.
(Mit der gaaaanz heißen Nadel gestrickt )
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "Tabelle1" Then
Call Aufruf
Else:
Call stoppen
End If
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Dim Z As Long
Dim S As Integer
Dim hEvent
Private Declare Function SetTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
Public Sub Aufruf()
Z = ActiveWindow.VisibleRange.Rows(1).Row
S = ActiveWindow.VisibleRange.Columns(1).Column
EnableTimer 100 'Millisekunden
End Sub
Public Sub stoppen()
DisableTimer
End Sub
Public Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long)
If ActiveWindow.VisibleRange.Rows(1).Row <> Z Then
Z = ActiveWindow.VisibleRange.Rows(1).Row
Call vertikal_Scroll
End If
If ActiveWindow.VisibleRange.Columns(1).Column <> S Then
S = ActiveWindow.VisibleRange.Columns(1).Column
Call Horizontal_Scroll
End If
End Sub
Public Function EnableTimer(ByVal msInterval As Long)
If hEvent <> 0 Then Exit Function
hEvent = SetTimer(0&, 0&, msInterval, AddressOf TimerProc)
End Function
Public Function DisableTimer()
If hEvent = 0 Then Exit Function
KillTimer 0&, hEvent
hEvent = 0
End Function
Public Sub Horizontal_Scroll()
MsgBox "Jetzt wird horizontal gescrollt"
End Sub
Public Sub vertikal_Scroll()
MsgBox "Jetzt wird vertikal gescrollt"
End Sub
ransi