scrollbar_change event

Sub ScrollBar1_Change() '[B1].Value = ActiveWindow.ScrollColumn 'als Programmierhilfe Zwischenablage zum Prüfen der Position If ActiveWindow.ScrollColumn = 186 Then CB_ErstesHalbjahr.Visible = True CB_ZweitesHalbjahr.Visible = False End If End Sub

option explicit dim Jahr as Date Sub Worksheet_Change(ByVal ZielAs Range) 'PerfEin 'Schaltet das Performance Makro ein Jahr = "01.01." & Range("A1") If Ziel = Range("A1") Then If Jahr Mod 4 0 Then Columns("BM:BM").EntireColumn.Hidden = True Else: Columns("BM:BM").EntireColumn.Hidden = False End If End If 'PerfAus 'Schaltet das Performance Makro wieder aus End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Worksheet_Change(ByVal Ziel As Range) Dim Jahr As Date Jahr = "01.01." & Range("A1") 'ergibt kein Jahr sondern ein Datum, z.B. 1.1.23: 44927, 2.1.23: 44928, usw If Ziel.Value = Range("A1").Value Then Columns("BM:BM").Hidden = CBool(Jahr Mod 4) 'also bei 3 von 4 Tage versteckt 'Columns("BM:BM").Hidden = CBool(Year(Jahr) Mod 4) 'bei 3 von 4 Jahren versteckt End If CB_ErstesHalbjahr.Visible = ActiveCell.Column >= 186 CB_ZweitesHalbjahr.Visible = ActiveCell.Column

Hallo zusammen,
ich greife das Thema noch mal auf.
Wie schon von den anderen angemerkt, gibt es für ein Worksheet in Excel kein Scrollchangeevent.
Neben den angeführten Alternativen findet man im Netz auch die Verwendung von Platzhalterobjekten, ähnlich wie es Fennek ja auch angeführt hat.
Eine weitere Alternative ist das Einhooken in die Excel-Fensterprozedur via API und das Abfangen der VM_SCROLL-Message.
Einfacher ist das WinEventHooking. Hierbei wird z.B. die Beendigung des Scrollvorgangs abgefangen. Leider ist dies nicht auf die gewünschte Scrollbar beschränkt,
so dass ich noch etwas Einschränkungscode miteinpflegen musste. Auch um die Belastung von Excel zu minimieren wird z.B. bei Verlasssen von Excel das Hooking abgeschaltet.
Beim Scrollen des Bildschirms wird ein Event ausgelöst.
Probiere es doch einfach mal aus, da ich nicht weiß ob Excel das in jeder Lebenslage zeitlich duerhaft handelt..
Bitte das Ausschalten des Events bei Blattwechsel bzw. spätenstens bei Mappenschließung sicherstellen.

Code:


Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
        ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function SetWinEventHook Lib "user32" ( _
        ByVal eventMin As Long, ByVal eventMax As Long, _
        ByVal hmodWinEventProc As LongPtr, _
        ByVal lpfnWinEventProc As LongPtr, ByVal idProcess As Long, _
        ByVal idThread As Long, ByVal dwflags As Long) As LongPtr
Private Declare PtrSafe Function UnhookWinEvent Lib "user32" ( _
        ByVal hWinEventHook As LongPtr) As Long
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr

Dim hCurWin As LongPtr                                ' Handle de aktiven Fensters
Dim hWinEvent As LongPtr, hScrollEvent As LongPtr     ' Handle des Eventhooking
Private Const tblTab As String = "Scrollhooking"      ' Tabellenblatt, in dem Hooking stattf.

Public Sub StartWinEvents()
  If ActiveSheet.Name <> tblTab Then Exit Sub         ' Scrolltest nur auf gewünschtem Blatt
  hCurWin = GetActiveWindow
  If hWinEvent = 0 Then
     hWinEvent = SetWinEventHook(3, 3, 0, AddressOf WinEventProc, 0, 0, 0)
     Call StartScrollEvents                           ' Scrollhooking starten
  End If
End Sub

Public Sub StartScrollEvents()
  If hScrollEvent = 0 Then                            ' Baut den Scrollhook auf
     hScrollEvent = SetWinEventHook(19, 19, 0, AddressOf ScrollEventProc, 0, 0, 0)
  End If
End Sub

Sub StopAllEvents()
  UnhookWinEvent hWinEvent: hWinEvent = 0             ' Beendet den Win-Eventhook
  UnhookWinEvent hScrollEvent: hScrollEvent = 0       ' Beendet den Scroll-Eventhook
End Sub

Private Function WinEventProc(ByVal hWinEventHook As LongPtr, ByVal WinEvent As Long, _
        ByVal hwnd As LongPtr, ByVal idObject As Long, ByVal idChild As Long, _
        ByVal dwEventThread As Long, ByVal dwmsEventTime As Long) As Long
  If hwnd = Application.hwnd Then
     StartScrollEvents                                ' Excel wieder aktiv?
  Else
     If hCurWin = Application.hwnd Then
        UnhookWinEvent hScrollEvent: hScrollEvent = 0 ' Beendet den Scroll-Eventhook
     End If
  End If
  hCurWin = GetActiveWindow
End Function

Private Function ScrollEventProc(ByVal hWinEventHook As LongPtr, ByVal WinEvent As Long, _
        ByVal hwnd As LongPtr, ByVal idObject As Long, ByVal idChild As Long, _
        ByVal dwEventThread As Long, ByVal dwmsEventTime As Long) As Long
  If ActiveSheet.Name = tblTab Then MsgBox "Mach Dein  Ding", vbExclamation, "Scrollalarm"
End Function


' in Das Tabellenblattmodul
Private Sub Worksheet_Activate()
  Call StartWinEvents
End Sub

Private Sub Worksheet_Deactivate()
  Call StopAllEvents
End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

scrollbar_change event

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread