A Worksheet OnScroll Event ! - How cool is that ?

Jaafar Tribak

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,807
Office Version
  1. 2016
Platform
  1. Windows
Hi all,

There is no such event in excel. Using a timer to constantly monitor any change of the ScrollRow/ScrollColumn of the activewindow is feasible but it is not worth it because of the strain that such a running timer would put on the application.

While playing around with some Controls via the "More Controls" icon on the ToolBox Toolbar, I came accross this ActiveX control named: InkPicture which has an interesting event called InkPicture_Painted and which basically fires every time it receives a repaint message.

I thought , maybe if i place one on the worksheet , the Control paint event would fire when scrolling the worksheet. Guess what: It worked :)

I embeeded one into the worksheet and reduced its width to a minimum so that it's almost invisible. I streched its height over 1000 rows so it covers a reasonable down/scrolling region.

Ok. Now, before I get too excited about this, there is a problem: Does this InkPicture Control come with all or most Office standard installations like the OWC controls? if so then great. if not, i should just forget about this whole thing. (i am running Office XP XL 2003)

Notice that there is also an annoying prompt upon opening a workbook containing an embeeded ActiveX control. Fortunatly, this can be avoided by adding a reference to the Control library ( MS Tablet PC Type Lib) Programatically , adding the Control at run time and hooking its events in a Class module.

here is a a workbook demo that shows an implementation of this custom Worksheet Scroll Event (it captures the event to prevent the user from scrolling down beyond the visible range ) : http://www.savefile.com/files/1158486

I would appreciate any feedback on this as i would like to know if it works on different machines/XL versions.

Regards.
 
Sort by date Sort by votes
Hi,
This looks very interesting!
Any solution to the problem above?

Or anywhere to get the example-file? It seems to have disappeared from "SaveFile" (time-out)?

Thanks//
Jörgen
 
Upvote 0

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
I think the reason the code fails, is that when you add an OLEObject to a worksheet, you reset the VBProject and this clears all the public variables, so the instance of the class no longer exists.
 
Upvote 0
Hello,

I know it has been years but this still appears to be one of the best solutions available. Saddly the www.savefile.com link in the initial post does not seem to be working any more and I havent been able to get the code to work on my own.

Does anyone still have an example of this working they could share with me?

I really appreciate any help you can give

Jaafar Tribak said:
Hi all,

There is no such event in excel. Using a timer to constantly monitor any change of the ScrollRow/ScrollColumn of the activewindow is feasible but it is not worth it because of the strain that such a running timer would put on the application.

While playing around with some Controls via the "More Controls" icon on the ToolBox Toolbar, I came accross this ActiveX control named: InkPicture which has an interesting event called InkPicture_Painted and which basically fires every time it receives a repaint message.

I thought , maybe if i place one on the worksheet , the Control paint event would fire when scrolling the worksheet. Guess what: It worked :)

I embeeded one into the worksheet and reduced its width to a minimum so that it's almost invisible. I streched its height over 1000 rows so it covers a reasonable down/scrolling region.

Ok. Now, before I get too excited about this, there is a problem: Does this InkPicture Control come with all or most Office standard installations like the OWC controls? if so then great. if not, i should just forget about this whole thing. (i am running Office XP XL 2003)

Notice that there is also an annoying prompt upon opening a workbook containing an embeeded ActiveX control. Fortunatly, this can be avoided by adding a reference to the Control library ( MS Tablet PC Type Lib) Programatically , adding the Control at run time and hooking its events in a Class module.

here is a a workbook demo that shows an implementation of this custom Worksheet Scroll Event (it captures the event to prevent the user from scrolling down beyond the visible range ) : http://www.savefile.com/files/1158486

I would appreciate any feedback on this as i would like to know if it works on different machines/XL versions.

Regards.
Click to expand...
 
Upvote 0
Logan_Traceur said:
Hello,

I know it has been years but this still appears to be one of the best solutions available. Saddly the www.savefile.com link in the initial post does not seem to be working any more and I havent been able to get the code to work on my own.

Does anyone still have an example of this working they could share with me?

I really appreciate any help you can give
Click to expand...

Hi Logan_Traceur,

I don't think this tacky workaround is stable enough to rely on.

I think that short of subclassing the excel application from a dll , the only way of catching the scrolling of worksheets is via the use of a Windows Timer (SetTimer) .. I'll try to post some code later on .
 
Last edited:
Upvote 0
Jaafar Tribak said:
Hi Logan_Traceur,

I don't think this tacky workaround is stable enough to rely on.

I think that short of subclassing the excel application from a dll , the only way of catching the scrolling of worksheets is via the use of a Windows Timer (SetTimer) .. I'll try to post some code later on .
Click to expand...

Thanks Jaafar! I look forward to your suggestion
 
Upvote 0
Logan_Traceur said:
Thanks Jaafar! I look forward to your suggestion
Click to expand...

Hi,

The Timer approach turned out to be more difficult than I initially expected specially that I wanted to keep the signature of the scroll events in line with the standard native events format... This is not perfect but it is the closest I could arrived at.

Here is the entire code in a Standard Module .

Run the Start routine to enable the scroll event and the Finish routine to disable the event.

The following example shows how to prevent the user from scrolling beyond Column(AA) and Row(100) on Sheet1

Code: 
Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private oTargetSheet As Worksheet

Public Sub Start()
    EanbleScrollEvent = True
End Sub

Public Sub Finish()
    EanbleScrollEvent = False
End Sub


[B][COLOR=#008000]'/////////////////////////////////////
'           PRIVATE ROUTINES
'/////////////////////////////////////[/COLOR][/B]

Private Property Let EanbleScrollEvent(ByVal Enable As Boolean)
    KillTimer Application.hwnd, 0
    If Enable Then
        SetTimer Application.hwnd, 0, 0, AddressOf TimerProc
    Else
        If Not oTargetSheet Is Nothing Then oTargetSheet.ScrollArea = ""
    End If
End Property

Private Sub Auto_Close()
    Call Finish
End Sub

Private Sub TimerProc()
    Static lPrevLastColumn As Long
    Static lPrevLastRow As Long
    Dim col As Long, Rw As Long
    Dim bCancel As Boolean
    
    KillTimer Application.hwnd, 0
    With ActiveWindow
        If .VisibleRange.Column + .VisibleRange.Columns.Count > lPrevLastColumn Then
            col = On_Sheet_H_Scroll(bCancel)
        End If
        If .VisibleRange.Row + .VisibleRange.Rows.Count > lPrevLastRow Then
            Rw = On_Sheet_V_Scroll(bCancel)
        End If
        Set oTargetSheet = ActiveSheet
        If Rw = 0 Then Rw = Rows.Count
        If col = 0 Then col = Columns.Count
        If bCancel Then
            ActiveSheet.ScrollArea = Range(Cells(1, 1), Cells(Rw, col)).Address
        End If
Xit:
        lPrevLastColumn = .VisibleRange.Column + .VisibleRange.Columns.Count
        lPrevLastRow = .VisibleRange.Row + .VisibleRange.Rows.Count
    End With
    EanbleScrollEvent = True
End Sub


[B][COLOR=#008000]'/////////////////////////////////////
'           PSEUDO-EVENTS
'/////////////////////////////////////[/COLOR][/B]


[B][COLOR=#008000]'(1) PSEUDO-EVENT for HORIZONTAL Scrolling.
'======================================[/COLOR][/B]

Private Function On_Sheet_H_Scroll(ByRef Cancel As Boolean) As Long
   [B][COLOR=#008000] 'Prevent scrolling beyond Column(AA)[/COLOR][/B]
    If ActiveSheet Is Sheet1 Then
        With ActiveWindow
            If Not Intersect(ActiveWindow.VisibleRange, Columns(27)) Is Nothing Then
                Cancel = True
                On_Sheet_H_Scroll = 27
                MsgBox "Can't scroll beyond Column(AA)!"
            End If
        End With
    End If
End Function

[B][COLOR=#008000]'(2) PSEUDO-EVENT for VERTICAL Scrolling.
'======================================[/COLOR][/B]

Private Function On_Sheet_V_Scroll(ByRef Cancel As Boolean) As Long
    [B][COLOR=#008000]'Prevent scrolling beyond Row(100)[/COLOR][/B]
    If ActiveSheet Is Sheet1 Then
        With ActiveWindow
            If Not Intersect(ActiveWindow.VisibleRange, Rows(100)) Is Nothing Then
                Cancel = True
                On_Sheet_V_Scroll = 100
                MsgBox "Can't scroll beyond Row(100)!"
            End If
        End With
    End If
End Function
 
Upvote 0
I revisited the above code this morning and discovered two issues :

1- Code errors out when selecting the worksheet from another sheet.
2- Logical error - code event never runs when scrolling up or left.

I have now fixed those issues, so please, ignore the previous code and use this one instead :

Standard Module:
Code: 
Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private oTargetSheet As Worksheet

Public Sub Start()
    EanbleScrollEvent = True
End Sub

Public Sub Finish()
    EanbleScrollEvent = False
End Sub


[B][COLOR=#008000]'/////////////////////////////////////
'           PRIVATE ROUTINES
'/////////////////////////////////////[/COLOR][/B]

Private Property Let EanbleScrollEvent(ByVal Enable As Boolean)
    KillTimer Application.hwnd, 0
    If Enable Then
        SetTimer Application.hwnd, 0, 0, AddressOf TimerProc
    Else
        If Not oTargetSheet Is Nothing Then oTargetSheet.ScrollArea = ""
    End If
End Property

Private Sub Auto_Close()
    Call Finish
End Sub

Private Sub TimerProc()
    Static lPrevLastColumn As Long
    Static lPrevLastRow As Long
    Dim col As Long, Rw As Long
    Dim bCancel As Boolean
    
    On Error Resume Next
    
    KillTimer Application.hwnd, 0
    With ActiveWindow
        If .VisibleRange.Column + .VisibleRange.Columns.Count <> lPrevLastColumn Then
            col = On_Sheet_H_Scroll(bCancel)
        End If
        If .VisibleRange.Row + .VisibleRange.Rows.Count <> lPrevLastRow Then
            Rw = On_Sheet_V_Scroll(bCancel)
        End If
        Set oTargetSheet = ActiveSheet
        If Rw = 0 Then Rw = Rows.Count
        If col = 0 Then col = Columns.Count
        If bCancel Then
            ActiveSheet.ScrollArea = Range(Cells(1, 1), Cells(Rw, col)).Address
        End If
Xit:
        lPrevLastColumn = .VisibleRange.Column + .VisibleRange.Columns.Count
        lPrevLastRow = .VisibleRange.Row + .VisibleRange.Rows.Count
    End With
    EanbleScrollEvent = True
End Sub


[COLOR=#008000][B]'/////////////////////////////////////
'           PSEUDO-EVENTS
'/////////////////////////////////////[/B][/COLOR]


[B][COLOR=#008000]'(1) PSEUDO-EVENT for HORIZONTAL Scrolling.
'======================================[/COLOR][/B]
Private Function On_Sheet_H_Scroll(ByRef Cancel As Boolean) As Long
    [B][COLOR=#008000]'Prevent scrolling beyond Column(AA)[/COLOR][/B]
    If ActiveSheet Is Sheet1 Then
        With ActiveWindow
            If Not Intersect(.VisibleRange, Columns(27)) Is Nothing Then
                Cancel = True
                On_Sheet_H_Scroll = 27
                MsgBox "Can't scroll beyond Column(AA)!"
            End If
        End With
    End If
End Function

[B][COLOR=#008000]'(2) PSEUDO-EVENT for VERTICAL Scrolling.
'======================================[/COLOR][/B]
Private Function On_Sheet_V_Scroll(ByRef Cancel As Boolean) As Long
    [B][COLOR=#008000]'Prevent scrolling beyond Row(100)[/COLOR][/B]
    If ActiveSheet Is Sheet1 Then
        With ActiveWindow
            If Not Intersect(.VisibleRange, Rows(100)) Is Nothing Then
                Cancel = True
                On_Sheet_V_Scroll = 100
                MsgBox "Can't scroll beyond Row(100)!"
            End If
        End With
    End If
End Function
 
Upvote 0
Hmm I have copied, your code into a standard module but events dont seem to be fireing.

Can you upload an example, or is there something I am missing?
Capture.jpg



Jaafar Tribak said:
I revisited the above code this morning and discovered two issues :

1- Code errors out when selecting the worksheet from another sheet.
2- Logical error - code event never runs when scrolling up or left.

I have now fixed those issues, so please, ignore the previous code and use this one instead :

Standard Module:
Code: 
Option Explicit

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    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
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Private oTargetSheet As Worksheet

Public Sub Start()
    EanbleScrollEvent = True
End Sub

Public Sub Finish()
    EanbleScrollEvent = False
End Sub


[B][COLOR=#008000]'/////////////////////////////////////
'           PRIVATE ROUTINES
'/////////////////////////////////////[/COLOR][/B]

Private Property Let EanbleScrollEvent(ByVal Enable As Boolean)
    KillTimer Application.hwnd, 0
    If Enable Then
        SetTimer Application.hwnd, 0, 0, AddressOf TimerProc
    Else
        If Not oTargetSheet Is Nothing Then oTargetSheet.ScrollArea = ""
    End If
End Property

Private Sub Auto_Close()
    Call Finish
End Sub

Private Sub TimerProc()
    Static lPrevLastColumn As Long
    Static lPrevLastRow As Long
    Dim col As Long, Rw As Long
    Dim bCancel As Boolean
    
    On Error Resume Next
    
    KillTimer Application.hwnd, 0
    With ActiveWindow
        If .VisibleRange.Column + .VisibleRange.Columns.Count <> lPrevLastColumn Then
            col = On_Sheet_H_Scroll(bCancel)
        End If
        If .VisibleRange.Row + .VisibleRange.Rows.Count <> lPrevLastRow Then
            Rw = On_Sheet_V_Scroll(bCancel)
        End If
        Set oTargetSheet = ActiveSheet
        If Rw = 0 Then Rw = Rows.Count
        If col = 0 Then col = Columns.Count
        If bCancel Then
            ActiveSheet.ScrollArea = Range(Cells(1, 1), Cells(Rw, col)).Address
        End If
Xit:
        lPrevLastColumn = .VisibleRange.Column + .VisibleRange.Columns.Count
        lPrevLastRow = .VisibleRange.Row + .VisibleRange.Rows.Count
    End With
    EanbleScrollEvent = True
End Sub


[COLOR=#008000][B]'/////////////////////////////////////
'           PSEUDO-EVENTS
'/////////////////////////////////////[/B][/COLOR]


[B][COLOR=#008000]'(1) PSEUDO-EVENT for HORIZONTAL Scrolling.
'======================================[/COLOR][/B]
Private Function On_Sheet_H_Scroll(ByRef Cancel As Boolean) As Long
    [B][COLOR=#008000]'Prevent scrolling beyond Column(AA)[/COLOR][/B]
    If ActiveSheet Is Sheet1 Then
        With ActiveWindow
            If Not Intersect(.VisibleRange, Columns(27)) Is Nothing Then
                Cancel = True
                On_Sheet_H_Scroll = 27
                MsgBox "Can't scroll beyond Column(AA)!"
            End If
        End With
    End If
End Function

[B][COLOR=#008000]'(2) PSEUDO-EVENT for VERTICAL Scrolling.
'======================================[/COLOR][/B]
Private Function On_Sheet_V_Scroll(ByRef Cancel As Boolean) As Long
    [B][COLOR=#008000]'Prevent scrolling beyond Row(100)[/COLOR][/B]
    If ActiveSheet Is Sheet1 Then
        With ActiveWindow
            If Not Intersect(.VisibleRange, Rows(100)) Is Nothing Then
                Cancel = True
                On_Sheet_V_Scroll = 100
                MsgBox "Can't scroll beyond Row(100)!"
            End If
        End With
    End If
End Function
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
1K
AndyEd
A
A
  • Solved
Code Isn't Triggering With Worksheet Change Event
Replies
3
Views
781
Ark68
A
C
  • Question Question
Excel Custom Ribbon Drop Down Element - How to View Id, Index, Label for Each Item
Replies
0
Views
2K
CurtisD
C
A
  • Solved
Calendar issue
Replies
1
Views
2K
AndyEd
A
F
  • Solved
Copy selected range to another worksheet, stop, and go to the next record to select (VBA)
Replies
3
Views
206
Alex Blakenburg
A

Forum statistics

Threads
1,224,828
Messages
6,181,209
Members
453,022
Latest member
RobertV1609

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top