Retrieving the Text being displayed on the Status Bar

Jaafar Tribak

Jaafar Tribak

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

You know when you perform tasks in excel such as copying cells, entering edit mode, turning on the ScrollLock key, dragging and dropping cells or using the fill down feature etc .. , the text on the status bar changes accordingly to reflect the current state or the action being performed.

I was wondering if there was a way of retreiving that text dynamically.

I have tried using the GetWindowText API but it doesn't work .

My ultimate goal is to be able to detect when the user is about to start dragging and dropping cells or using the fill down feature and prevent them from doing so... I thought I could achieve this by reading the statusbar text.

Any ideas.

Regards.
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
Can anyone please tell me the exact text that gets displayed on the status bar when dragging a cell and when entering Edit mode ?

I use a french edition of excel so the text is rendered in french and not in english.

Thank you.
 
Upvote 0
Hello,
The dragging a cell is
Drag outside selection to extend series or fill; drag inside to clear
and not to sure the Edit mode?
 
Upvote 0
pike said:
Hello,
The dragging a cell is
Drag outside selection to extend series or fill; drag inside to clear
and not to sure the Edit mode?
Click to expand...

Thank you Pike for answering.

To see the displayed text on the statusbar for Edit mode just double-Click any cell .
 
Upvote 0
In case anyone is interested, here is what I have come up with :

1- In a 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 AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Private Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As LongPtr)
    Private Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
    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 Proc1Addr As LongPtr, Proc2Addr As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
    Private Declare Function GetFocus Lib "user32" () As Long
    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
    Private Proc1Addr As Long, Proc2Addr As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const MOUSEEVENTF_LEFTUP = &H4
Private bStatusBarHidden As Boolean

Sub StartTimer()
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        Proc1Addr = VBA.CLngPtr(AddressOf StartWatching)
        Proc2Addr = VBA.CLngPtr(AddressOf HandlePopupWindows)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Proc1Addr = VBA.CLng(AddressOf StartWatching)
        Proc2Addr = VBA.CLng(AddressOf HandlePopupWindows)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    
    bStatusBarHidden = False
    KillTimer Application.hwnd, 0
    SetTimer Application.hwnd, 0, 0, AddressOf StartWatching
End Sub

Sub StopTimer()
    KillTimer Application.hwnd, 0
    If bStatusBarHidden Then Application.DisplayStatusBar = False
End Sub

Sub StartWatching()
    Dim oIacc As Variant, i As Long, bCancel As Boolean
    
    If Not ActiveWorkbook Is ThisWorkbook Then Exit Sub
    Set oIacc = Application.CommandBars("Status Bar")
    If oIacc.Visible Then
        For i = 0 To 6
            AccessibleChildren oIacc, IIf(i Mod 2 = 0, 0, 3), 1, oIacc, 1
        Next i
        If InStr(1, UCase(oIacc.accName(0&)), UCase("glisser")) Or InStr(1, UCase(oIacc.accName(0&)), UCase("Drag")) Then
            KillTimer Application.hwnd, 0
            SetTimer Application.hwnd, 0, 0, Proc2Addr
            Call Cells_BeforeDragOver(Selection, bCancel)
            If bCancel Then mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
            SetTimer Application.hwnd, 0, 0, Proc1Addr
        End If
    Else
        bStatusBarHidden = True
        Application.DisplayStatusBar = True
    End If
End Sub

Sub HandlePopupWindows()
    KillTimer Application.hwnd, 0
    If GetFocus <> Application.hwnd Then mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub


[B][COLOR=#006400]'****************************************************************
'                      Pseudo Event                             *
'****************************************************************

'Example : Cancel Dragging Cells in Column A
'-------------------------------------------[/COLOR][/B]
Sub Cells_BeforeDragOver(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 Then
        MsgBox "Dragging Cells in Column:'A'" & vbNewLine & _
        "is not allowed.", vbCritical
        Cancel = True
    End If
End Sub

2- Code Usage :

In the ThisWorkbook Module :
Code: 
Option Explicit

Private Sub Workbook_Open()
    Call StartTimer
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
End Sub

The code makes use of a windows timer which is not something I particularly like.

If I could run the timer-code out of process (like from a seperate hidden excel instance launched behind the scenes @ runtime ) it would be much better and safer... I'll see if I can do that next.

Note:
I have only tested the code on a french edition of excel (excel 2010 64bit) .. I am not sure if the code will also work on english editions because the code relies on the status bar UI text ... If someone can test the code for me and confirm that it works on english editions of excel, I'll appreciate it.

Regards.
 
Upvote 0
Here is an improved version of the previous code .. Now, 3 new arguments for the Alt,Ctrl and Shift keys were added to the Cells_BeforeDragOver Pseudo-Event routine.

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 AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Private Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As LongPtr)
    Private Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
    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 Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Proc1Addr As LongPtr, Proc2Addr As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
    Private Declare Function GetFocus Lib "user32" () As Long
    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
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Proc1Addr As Long, Proc2Addr As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const MOUSEEVENTF_LEFTUP = &H4
Private bStatusBarHidden As Boolean


Sub StartTimer()
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        Proc1Addr = VBA.CLngPtr(AddressOf StartWatching)
        Proc2Addr = VBA.CLngPtr(AddressOf HandlePopupWindows)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Proc1Addr = VBA.CLng(AddressOf StartWatching)
        Proc2Addr = VBA.CLng(AddressOf HandlePopupWindows)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    
    bStatusBarHidden = False
    KillTimer Application.hwnd, 0
    SetTimer Application.hwnd, 0, 0, AddressOf StartWatching
End Sub

Sub StopTimer()
    KillTimer Application.hwnd, 0
    If bStatusBarHidden Then Application.DisplayStatusBar = False
End Sub

Private Sub StartWatching()
    Dim oIacc As Variant, i As Long, bCancel As Boolean

    If Not ActiveWorkbook Is ThisWorkbook Then Exit Sub
    Set oIacc = Application.CommandBars("Status Bar")
    If oIacc.Visible Then
        For i = 0 To 6
            AccessibleChildren oIacc, IIf(i Mod 2 = 0, 0, 3), 1, oIacc, 1
        Next i
        If InStr(1, UCase(oIacc.accName(0&)), UCase("glisser")) Or InStr(1, UCase(oIacc.accName(0&)), UCase("Drag")) Then
            KillTimer Application.hwnd, 0
            SetTimer Application.hwnd, 0, 0, Proc2Addr
            Call Cells_BeforeDragOver(ActiveWindow.RangeSelection, CBool(GetAsyncKeyState(vbKeyMenu)), _
            CBool(GetAsyncKeyState(vbKeyControl)), CBool(GetAsyncKeyState(vbKeyShift)), bCancel)
            If bCancel Then mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
            SetTimer Application.hwnd, 0, 0, Proc1Addr
        End If
    Else
        bStatusBarHidden = True
        Application.DisplayStatusBar = True
    End If
End Sub

Private Sub HandlePopupWindows()
    KillTimer Application.hwnd, 0
    If GetFocus <> Application.hwnd Then mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub



[B][COLOR=#006400]'****************************************************************[/COLOR][/B]
[B][COLOR=#006400]'                      Pseudo Event                             *[/COLOR][/B]
[B][COLOR=#006400]'****************************************************************[/COLOR][/B]
[B][COLOR=#006400]
[/COLOR][/B]
[B][COLOR=#006400]' Example : Cancel Dragging Cells in Column A[/COLOR][/B]
[B][COLOR=#006400]'--------------------------------------------[/COLOR][/B]
Private Sub Cells_BeforeDragOver( _
    ByVal Target As Range, _
    ByVal Alt As Boolean, _
    ByVal Ctrl As Boolean, _
    ByVal Shift As Boolean, _
    ByRef Cancel As Boolean _
)
    If Target.Column = 1 Then
        MsgBox "Dragging Cells in Column:'A'" & vbNewLine & _
        "is not allowed.", vbCritical
        Cancel = True
    End If
    
End Sub
 
Upvote 0
Hello,
Excellent, this is often requested and will be very handy. Service desks get very annoyed if copy , paste ect,, is not enabled in a workbook
 
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
379
AndyEd
A
A
  • Solved
Calendar issue
Replies
1
Views
1K
AndyEd
A
D
  • Question
QRCode Generator
Replies
1
Views
1K
drag1c
D
L
  • Question
VBA works on work PC but not home PC
Replies
3
Views
2K
rollis13
rollis13
A
  • Question
Page break issues when exporting to pdf from userform (VBA)
Replies
0
Views
692
auglocqnuk
A

Forum statistics

Threads
1,214,577
Messages
6,120,359
Members
448,956
Latest member
Adamsxl

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