AW: "sanftes" scrollen?
29.05.2020 16:36:15
fcs
Hallo Fred,
hier noch zwei Varianten, die im Prinzip die gleichen Ideen beinhalten, wie die anderen,
jedoch werden die anzuscrollenden Werte und Wartezeiten von einem Hauptmakro an eine Subroutine übergeben.
So kannst du dann auch einfach durch erneuten Aufruf mit anderen Parametern die Spalte 1 ansteuern.
LG
Franz
Sub scroll_1_to_Z1S240()
'Nach Zeile 1, Spalte 240 scrollen
Call fncScroll_1(Zeile:=1, Spalte:=240, _
DeltaZeile:=10, _
DeltaSpalte:=5, _
dblSekunden:=0.1)
'von Spalte 240 nach Spalte 1 scrollen
Call fncScroll_1(Zeile:=1, Spalte:=1, _
DeltaZeile:=1, _
DeltaSpalte:=1, _
dblSekunden:=0.1)
End Sub
Function fncScroll_1(Zeile As Long, Spalte As Long, _
DeltaZeile As Long, _
DeltaSpalte As Long, _
Optional dblSekunden As Double = 0.01) As Boolean
'Zeile = Zielzeile für das Scrollen
'Spalte = Zielspalte für das Scrollen
'DeltaZeile = Spaltenverschiebung je Scroll
'DeltaSpalte = Zeileverschiebung je Scroll
'dblSekunden = Wartezeit in Sekunden zwischen Scrolls
Dim Spa As Long, Zei As Long
Dim bolSpa As Boolean, bolZei As Boolean
Dim dblTime
Zei = ActiveWindow.VisibleRange.Row
bolZei = Zeile > Zei
DeltaZeile = DeltaZeile * IIf(bolZei, 1, -1)
Spa = ActiveWindow.VisibleRange.Column
bolSpa = Spalte > Spa
DeltaSpalte = DeltaSpalte * IIf(bolSpa, 1, -1)
Do
Zei = Zei + DeltaZeile
Spa = Spa + DeltaSpalte
If (bolZei = True And Zei > Zeile) _
Or (bolZei = False And Zei Spalte) _
Or (bolSpa = False And Spa dblSekunden Then Exit Do
Loop
Loop
End Function
Sub scroll_2_to_Z1S240()
Call fncScroll_2(Zeile:=1, Spalte:=240, _
AnzahlScrolls:=5, _
dblSekunden:=0.3)
End Sub
Function fncScroll_2(Zeile As Long, Spalte As Long, _
AnzahlScrolls As Long, _
Optional dblSekunden As Double = 0.01) As Boolean
'Zeile = Zielzeile für das Scrollen
'Spalte = Zielspalte für das Scrollen
'dblSekunden = Wartezeit in Sekunden zwischen Scrolls
Dim Spa As Long, Zei As Long
Dim bolSpa As Boolean, bolZei As Boolean
Dim DeltaZeile As Long 'Spaltenverschiebung je Scroll
Dim DeltaSpalte As Long 'Zeileverschiebung je Scroll
Dim dblTime
Zei = ActiveWindow.VisibleRange.Row
bolZei = Zeile > Zei
DeltaZeile = Application.WorksheetFunction.Max(1, CLng(Abs(Zeile - Zei) / _
AnzahlScrolls)) * IIf(bolZei, 1, -1)
Spa = ActiveWindow.VisibleRange.Column
bolSpa = Spalte > Spa
DeltaSpalte = Application.WorksheetFunction.Max(1, CLng(Abs(Spalte - Spa) / _
AnzahlScrolls)) * IIf(bolSpa, 1, -1)
Do
Zei = Zei + DeltaZeile
Spa = Spa + DeltaSpalte
If (bolZei = True And Zei > Zeile) _
Or (bolZei = False And Zei Spalte) _
Or (bolSpa = False And Spa dblSekunden Then Exit Do
Loop
Loop
End Function