MS Excel Status bar customization. Is possible?

O

omairhe

Well-known Member
Joined
Mar 26, 2009
Messages
2,040
Office Version
  1. 2019
Platform
  1. Windows
Hello all,

Does Microsoft Excel provide a built-in method to selectively enable or disable specific functions (such as "Count" and "Average") in the status bar through VBA or any other means for specific workbooks only?

Thanks.
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
omairhe said:
Hello all,

Does Microsoft Excel provide a built-in method to selectively enable or disable specific functions (such as "Count" and "Average") in the status bar through VBA or any other means for specific workbooks only?

Thanks.
Click to expand...
AFAIK, excel doesn't offer a way of manipulating those specific statusbar display elements either via the user Interface or programmatically.

Maybe a *possible* workaround can be attempted using a combination of MSAA and the win32 api but I am not sure how well it will work.
 
Last edited:
Upvote 0
Hi omairhe

This question raised my interest so I gave it a shot ... Selectively enabling & disabling individual entries in the excel statusbar programmatically turned out to be rather difficult even with the help of the UIAutomationClient and Win32 api libraries.

Basically, the code I wrote stores each individual statusbar entry in a Public UDT (STATUSBAR_DISPLAY) so the user can either do mass or individual changes to the entries via the UDT members.

There are 25 entries in total in excel 2016 - Not sure if other versions of excel have the same # of entries. If so, the code will need some tweaking.

The user actions for enabling\disabling are defined in the STATUSBAR_DISPLAY_STATES Enum.
VBA Code: 
Private Enum STATUSBAR_DISPLAY_STATES
    Ignore = 0&    'Default
    Checked = 1&
    Unchecked = 2&
End Enum

Ignore ==> Skip, don't do anything and leave the entry as it was.
Checked ==> Enable the entry.
Unchecked ==> You guessed it right !


File Demo:
CustomizeStatusbarDisplayEntries.xlsm








1- Worker API code in a Standard Module:
VBA Code: 
Option Explicit

'This code requires adding a VBE reference to the UIAutomationClient library (UIAutomationCore.dll)

#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
    Private Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
    Private Declare PtrSafe Function SendInput Lib "USER32.DLL" (ByVal cInputs As Long, pInputs As Any, ByVal cbSize As Integer) As Long
    Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByVal riid As LongPtr, ppvObject As Any) As Long
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
    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
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
    Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
    Private Declare Function SendInput Lib "USER32.DLL" (ByVal cInputs As Long, pInputs As Any, ByVal cbSize As Integer) As Long
    Private Declare Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByVal riid As LongPtr, ppvObject As Any) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
    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
#End If

Private Enum STATUSBAR_DISPLAY_CHECKED
    Uncheck = 1048576
    Check = 1048592
End Enum

Private Enum STATUSBAR_DISPLAY_STATES
    Ignore = 0&    'Default
    Checked = 1&
    Unchecked = 2&
End Enum

Public Type STATUSBAR_DISPLAY
    CellMode                        As STATUSBAR_DISPLAY_STATES
    FlashFillBlankCells             As STATUSBAR_DISPLAY_STATES
    FlashFillChangedCells           As STATUSBAR_DISPLAY_STATES
    Signatures                      As STATUSBAR_DISPLAY_STATES
    InformationManagementPolicy     As STATUSBAR_DISPLAY_STATES
    Permissions                     As STATUSBAR_DISPLAY_STATES
    CapsLock                        As STATUSBAR_DISPLAY_STATES
    NumLock                         As STATUSBAR_DISPLAY_STATES
    ScrollLock                      As STATUSBAR_DISPLAY_STATES
    FixedDecimal                    As STATUSBAR_DISPLAY_STATES
    OvertypeMode                    As STATUSBAR_DISPLAY_STATES
    EndMode                         As STATUSBAR_DISPLAY_STATES
    MacroRecording                  As STATUSBAR_DISPLAY_STATES
    SelectionMode                   As STATUSBAR_DISPLAY_STATES
    PageNumber                      As STATUSBAR_DISPLAY_STATES
    Average                         As STATUSBAR_DISPLAY_STATES
    Count                           As STATUSBAR_DISPLAY_STATES
    NumericalCount                  As STATUSBAR_DISPLAY_STATES
    Minimum                         As STATUSBAR_DISPLAY_STATES
    Maximum                         As STATUSBAR_DISPLAY_STATES
    Sum                             As STATUSBAR_DISPLAY_STATES
    UploadStatus                    As STATUSBAR_DISPLAY_STATES
    ViewShortcuts                   As STATUSBAR_DISPLAY_STATES
    ZoomSlider                      As STATUSBAR_DISPLAY_STATES
    Zoom                            As STATUSBAR_DISPLAY_STATES
End Type

Private Type LongToInteger
    Low          As Integer
    High         As Integer
End Type

Private Type KEYBDINPUT
    wVk          As Integer
    wScan        As Integer
    dwFlags      As Long
    time         As Long
    dwExtraInfo  As LongPtr
    padding      As Currency
End Type

Private Type tagINPUT
    INPUTTYPE   As Long
    ki          As KEYBDINPUT
End Type

Private udtDisplay As STATUSBAR_DISPLAY


Public Sub CusomizeStatusBar(uDisplay As STATUSBAR_DISPLAY)
    Const WH_CBT = 5&, WM_MOUSEMOVE = &H200, WM_RBUTTONDOWN = &H204, WM_RBUTTONUP = &H205
    Dim hwnd As LongPtr, lHook As LongPtr, lp As Long
   
    On Error GoTo errHandler
    With uDisplay
        udtDisplay.Average = .Average
        udtDisplay.CapsLock = .CapsLock
        udtDisplay.CellMode = .CellMode
        udtDisplay.Count = .Count
        udtDisplay.EndMode = .EndMode
        udtDisplay.FixedDecimal = .FixedDecimal
        udtDisplay.FlashFillBlankCells = .FlashFillBlankCells
        udtDisplay.FlashFillChangedCells = .FlashFillChangedCells
        udtDisplay.InformationManagementPolicy = .InformationManagementPolicy
        udtDisplay.MacroRecording = .MacroRecording
        udtDisplay.Maximum = .Maximum
        udtDisplay.Minimum = .Minimum
        udtDisplay.NumericalCount = .NumericalCount
        udtDisplay.NumLock = .NumLock
        udtDisplay.OvertypeMode = .OvertypeMode
        udtDisplay.PageNumber = .PageNumber
        udtDisplay.Permissions = .Permissions
        udtDisplay.ScrollLock = .ScrollLock
        udtDisplay.SelectionMode = .SelectionMode
        udtDisplay.Signatures = .Signatures
        udtDisplay.Sum = .Sum
        udtDisplay.UploadStatus = .UploadStatus
        udtDisplay.ViewShortcuts = .ViewShortcuts
        udtDisplay.Zoom = .Zoom
        udtDisplay.ZoomSlider = .ZoomSlider
    End With
    Call UnhookWindowsHookEx(GetProp(Application.hwnd, "Hook"))
    lHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, NULL_PTR, GetCurrentThreadId)
    Call SetProp(Application.hwnd, "Hook", lHook)
    If Not Application.CommandBars("Status Bar").Visible Then
        Application.CommandBars("Status Bar").Visible = True
    End If
    hwnd = FindWindowEx(Application.hwnd, NULL_PTR, "EXCEL2", vbNullString)
    hwnd = FindWindowEx(hwnd, NULL_PTR, "MsoCommandBar", "Status Bar")
    Call SetTopMost(Application.hwnd, True)
    lp = MAKELPARAM(1, 1)
    Call SendMessage(hwnd, WM_MOUSEMOVE, NULL_PTR, ByVal lp)
    Call SendMessage(hwnd, WM_RBUTTONDOWN, NULL_PTR, ByVal lp)
    Call SendMessage(hwnd, WM_RBUTTONUP, NULL_PTR, ByVal lp)
errHandler:
    Call UnhookWindowsHookEx(GetProp(Application.hwnd, "Hook"))
    Call SetTopMost(Application.hwnd, False)
End Sub

Private Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Const HCBT_ACTIVATE = 5&
    Dim sBuff As String * 256&, lRet As Long
    Dim oAccSBarContextMenu As IAccessible, vAcc As Variant
   
    On Error Resume Next
    If idHook = HCBT_ACTIVATE Then
        lRet = GetClassName(wParam, sBuff, 256&)
        If Left(sBuff, lRet) = "Net UI Tool Window" Then
            Call UnhookWindowsHookEx(GetProp(Application.hwnd, "Hook"))
            Set oAccSBarContextMenu = HwndToAcc(wParam)
            Call AccessibleChildren(oAccSBarContextMenu, 3&, 1&, vAcc, 1&)
            Call ShowWindow(wParam, 0&)
            Call PressAltKey
            Call SearchAccChildren(vAcc)
        End If
    End If
    HookProc = CallNextHookEx(GetProp(Application.hwnd, "Hook"), idHook, ByVal wParam, ByVal lParam)
End Function

Private Sub SearchAccChildren(ByVal Acc As Variant)
    Dim oCUI As New CUIAutomation
    Dim oParentElement As IUIAutomationElement
    Dim oCondition As IUIAutomationCondition
    Dim oElement As IUIAutomationElement
    Dim oAllElementArray As IUIAutomationElementArray
    Dim i As Long, lNextDisplay As Long
   
    On Error Resume Next
    Set oParentElement = oCUI.ElementFromIAccessible(Acc, 0&)
    Set oCondition = oCUI.CreateTrueCondition
    Set oAllElementArray = oParentElement.FindAll(TreeScope_Children, oCondition)
    For i = 0& To oAllElementArray.Length - 1&
        Set oElement = oAllElementArray.GetElement(i)
        Call RecurseElements(oCUI, oElement, 0&, lNextDisplay)
    Next
End Sub
 
Private Sub RecurseElements( _
    ByVal oCUI As CUIAutomation, _
    ByVal oElement As IUIAutomationElement, _
    ByVal Level As Long, _
    ByRef NextDisplay As Long _
)
    Dim oCondition As IUIAutomationCondition
    Dim oAllElementArray As IUIAutomationElementArray
    Dim oSubElement As IUIAutomationElement
    Dim oIAccessiblePattern  As IUIAutomationLegacyIAccessiblePattern
    Dim oInvokePattern As IUIAutomationInvokePattern
    Dim oAccessible As IAccessible
    Dim lCurState As STATUSBAR_DISPLAY_CHECKED
    Dim lTempDisplay  As STATUSBAR_DISPLAY_STATES
    Dim i As Long
   
    Set oCondition = oCUI.CreateTrueCondition
    Set oAllElementArray = oElement.FindAll(TreeScope_Children, oCondition)
    For i = 0& To oAllElementArray.Length - 1&
        Set oSubElement = oAllElementArray.GetElement(i)
        If oElement.CurrentControlType = 50011 Then
            Set oIAccessiblePattern = oElement.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
            Set oAccessible = oIAccessiblePattern.GetIAccessible
            lCurState = oAccessible.accState(0&)
            Call CopyMemory(lTempDisplay, ByVal VarPtr(udtDisplay) + (4& * NextDisplay), 4&)
            Set oInvokePattern = oElement.GetCurrentPattern(UIA_InvokePatternId)
            Select Case lTempDisplay
                Case Is = Checked
                    If lCurState = Uncheck Then
                        oInvokePattern.Invoke
                    End If
                Case Is = Unchecked
                    If lCurState = Check Then
                        oInvokePattern.Invoke
                    End If
            End Select
            NextDisplay = NextDisplay + 1&
            Level = Level + 1&
        End If
        RecurseElements oCUI, oSubElement, Level, NextDisplay
    Next
End Sub

Private Function HwndToAcc(ByVal hwnd As LongPtr) As IAccessible
    Const ID_ACCESSIBLE As String = "{618736E0-3C3D-11CF-810C-00AA00389B71}"
    Const OBJID_WINDOW = 0&, S_OK = &H0&
    Dim tGUID(0& To 3&) As Long
    Dim oIAc As IAccessible
    hwnd = GetNextWindow(hwnd, 5&)
    If IIDFromString(StrPtr(ID_ACCESSIBLE), VarPtr(tGUID(0&))) = S_OK Then
        If AccessibleObjectFromWindow(hwnd, OBJID_WINDOW, VarPtr(tGUID(0&)), oIAc) = S_OK Then
           Set HwndToAcc = oIAc
        End If
    End If
End Function

Private Sub PressAltKey()
    Const KEYEVENTF_KEYUP = &H2, KEYEVENTF_UNICODE = &H4, VK_MENU = &H12
    ReDim InputArray(2&) As tagINPUT
    InputArray(0&).INPUTTYPE = 1&
    InputArray(0&).ki.wVk = VK_MENU
    InputArray(0&).ki.dwFlags = KEYEVENTF_UNICODE
    InputArray(1&).INPUTTYPE = 1&
    InputArray(1&).ki.wVk = VK_MENU
    InputArray(1&).ki.dwFlags = KEYEVENTF_UNICODE + KEYEVENTF_KEYUP
    Call SendInput(2&, InputArray(0&), LenB(InputArray(0&)))
End Sub

Private Sub SetTopMost(ByVal hwnd As LongPtr, ByVal bTopMost As Boolean)
    Const HWND_TOPMOST = -1, HWND_NOTOPMOST = -2, SWP_NOSIZE = &H1
    Const SWP_NOMOVE = &H2, SWP_SHOWWINDOW = &H40, SWP_ASYNCWINDOWPOS = &H4000
    DoEvents
    Call SetWindowPos(Application.hwnd, IIf(bTopMost, HWND_TOPMOST, HWND_NOTOPMOST), 0&, 0&, 0&, 0&, _
                      SWP_ASYNCWINDOWPOS + SWP_NOSIZE + SWP_SHOWWINDOW + SWP_NOMOVE)
End Sub

Private Function MAKELONG(wLow As Integer, wHigh As Integer) As Long
    MAKELONG = loword(wLow) Or (&H10000 * loword(wHigh))
End Function

Private Function MAKELPARAM(wLow As Integer, wHigh As Integer) As Long
    MAKELPARAM = MAKELONG(wLow, wHigh)
End Function

Private Function loword(ByVal Word As Long) As Integer
    Dim x As LongToInteger
    Call CopyMemory(x, Word, LenB(x))
    loword = x.Low
End Function

Private Function hiword(ByVal Word As Long) As Integer
    Dim x As LongToInteger
    Call CopyMemory(x, Word, LenB(x))
    hiword = x.High
End Function



2- Code Usage Example ( as per the attached file demo above)
VBA Code: 
Option Explicit

Public Sub ApplyChanges()

    Dim uStatusBar As STATUSBAR_DISPLAY
   
    With uStatusBar
        .CellMode = ValToEnum(Sheet1.CheckBoxes("Check1"))
        .FlashFillBlankCells = ValToEnum(Sheet1.CheckBoxes("Check2"))
        .FlashFillChangedCells = ValToEnum(Sheet1.CheckBoxes("Check3"))
        .Signatures = ValToEnum(Sheet1.CheckBoxes("Check4"))
        .InformationManagementPolicy = ValToEnum(Sheet1.CheckBoxes("Check5"))
        .Permissions = ValToEnum(Sheet1.CheckBoxes("Check6"))
        .CapsLock = ValToEnum(Sheet1.CheckBoxes("Check7"))
        .NumLock = ValToEnum(Sheet1.CheckBoxes("Check8"))
        .ScrollLock = ValToEnum(Sheet1.CheckBoxes("Check9"))
        .FixedDecimal = ValToEnum(Sheet1.CheckBoxes("Check10"))
        .OvertypeMode = ValToEnum(Sheet1.CheckBoxes("Check11"))
        .EndMode = ValToEnum(Sheet1.CheckBoxes("Check12"))
        .MacroRecording = ValToEnum(Sheet1.CheckBoxes("Check13"))
        .SelectionMode = ValToEnum(Sheet1.CheckBoxes("Check14"))
        .PageNumber = ValToEnum(Sheet1.CheckBoxes("Check15"))
        .Average = ValToEnum(Sheet1.CheckBoxes("Check16"))
        .Count = ValToEnum(Sheet1.CheckBoxes("Check17"))
        .NumericalCount = ValToEnum(Sheet1.CheckBoxes("Check18"))
        .Minimum = ValToEnum(Sheet1.CheckBoxes("Check19"))
        .Maximum = ValToEnum(Sheet1.CheckBoxes("Check20"))
        .Sum = ValToEnum(Sheet1.CheckBoxes("Check21"))
        .UploadStatus = ValToEnum(Sheet1.CheckBoxes("Check22"))
        .ViewShortcuts = ValToEnum(Sheet1.CheckBoxes("Check23"))
        .ZoomSlider = ValToEnum(Sheet1.CheckBoxes("Check24"))
        .Zoom = ValToEnum(Sheet1.CheckBoxes("Check25"))
    End With
   
    Call CusomizeStatusBar(uStatusBar)
   
    MsgBox "Changes have been applied to the StatusBar entries."

End Sub

Public Sub Enable_Disable_All()
    Dim oBtn As Excel.Button
    Dim sSpecialChar As String
   
    Set oBtn = Sheet1.Buttons(Application.Caller)
    If oBtn.Caption <> "Apply the changes to the StatusBar" Then
        Sheet1.CheckBoxes.Value = IIf(oBtn.Caption = "Enable All", xlOn, xlOff)
        Sheet1.Range("C4:C28") = IIf(oBtn.Caption = "Enable All", "Enable", "Disable")
        sSpecialChar = IIf(oBtn.Caption = "Enable All", Chr(252&), Chr(251&))
        Call FormatRange(Sheet1.Range("C4:C28"), sSpecialChar)
    End If
End Sub

' ____________________________________________ HELPER ROUTINES ___________________________________________

Private Sub Auto_Open()
    Call Reset
End Sub

Private Sub Reset()
    Sheet1.CheckBoxes.Value = xlMixed
    Sheet1.Range("C4:C28") = "Skip"
End Sub

Private Function ValToEnum(ByVal Chk As Excel.CheckBox) As Long
    ValToEnum = Switch(Chk.Value = xlOn, 1&, Chk.Value = xlOff, 2&, True, 0&)
End Function

Private Sub GenericClick()
    Static ChkVal As Long
    Dim oChk As Excel.CheckBox, oStateCell As Range
    Dim sSpecialChar As String
   
    Set oChk = Sheet1.CheckBoxes(Application.Caller)
    Set oStateCell = oChk.TopLeftCell.Offset(, 1&)
    oChk.Value = ChkVal Mod 3&
    oStateCell = Switch(ChkVal Mod 3& = 0&, "Disable", ChkVal Mod 3& = 1&, "Enable", ChkVal Mod 3& = 2&, "Skip")
    sSpecialChar = Switch(ChkVal Mod 3& = 0&, Chr(251&), ChkVal Mod 3& = 1&, Chr(252&), ChkVal Mod 3& = 2&, "")
    If Len(sSpecialChar) Then
        Call FormatRange(oStateCell, sSpecialChar, ChkVal)
    End If
    ChkVal = ChkVal + 1&
End Sub

Private Sub FormatRange(ByVal Cell As Range, ByVal SpecialChar As String, Optional ChkVal As Long = -1&)
    Dim oCell As Range
   
    With Cell
        .Value2 = .Worksheet.Evaluate(.Address & " &""  " & SpecialChar & """")
    End With
    If ChkVal = -1& Then
        For Each oCell In Cell.Cells
            oCell.Characters(Len(oCell), 1&).Font.Name = "Wingdings"
            oCell.Characters(Len(oCell), 1&).Font.Size = 14&
            oCell.Characters(Len(oCell), 1&).Font.Color = Switch(SpecialChar = Chr(252&), vbGreen, SpecialChar = Chr(251&), vbRed)
        Next
    Else
        Cell.Characters(Len(Cell), 1&).Font.Name = "Wingdings"
        Cell.Characters(Len(Cell), 1&).Font.Size = 14&
        Cell.Characters(Len(Cell), 1&).Font.Color = Switch(ChkVal Mod 3& = 0&, vbRed, ChkVal Mod 3&, vbGreen, ChkVal Mod 3& = 2&, 0&)
    End If
End Sub

Note that the project requires adding a VBE reference to the UIAutomationClient library (UIAutomationCore.dll)
 
Upvote 0
That looks amazing @Jaafar Tribak !!!

It appears there are 3 more in Excel 365:

Workbook Statistics
Sensitivity
Accessibility Checker

Screenshot 2023-08-25 174026.png


The following is from Excel 2007

Screenshot 2023-08-25 174419.png
 
Upvote 0
@johnnyL
Hey, thanks for the feedback and for showing me the statusbar differences in the various excel versions.

I think the code will need to be re-designed to make it dynamic... The UDT approach I used for storing the statubar entries is a static approach.

Taking a class-based approach (OOP) should be more suitable for this project.

Regards.
 
Upvote 0
Ok. Here is an update of the project which should now work in all excel versions regardless of the different number of Statusbar entries in each version.

In order to achieve this dynamic feature, this new code doesn't store the statusbar entries in a UDT... It uses a Class-based approach.

CStatusBarEntries Class Members:
st1.png



CStatusBarEntry Class Members:
st2.png



File Demo:
StatusBarAutomation.xlsm








1- Worker API code in a Standard Module:
VBA Code: 
Option Explicit

'This code requires adding a VBE reference to the UIAutomationClient library (UIAutomationCore.dll)

#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
    Private Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
    Private Declare PtrSafe Function SendInput Lib "USER32.DLL" (ByVal cInputs As Long, pInputs As Any, ByVal cbSize As Integer) As Long
    Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByVal riid As LongPtr, ppvObject As Any) As Long
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
    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
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
    Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
    Private Declare Function SendInput Lib "USER32.DLL" (ByVal cInputs As Long, pInputs As Any, ByVal cbSize As Integer) As Long
    Private Declare Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByVal riid As LongPtr, ppvObject As Any) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
    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
#End If

Private Enum STATUSBAR_DISPLAY_CHECKED
    Unchecked = 1048576
    Checked = 1048592
End Enum

Private Type LongToInteger
    Low          As Integer
    High         As Integer
End Type

Private Type KEYBDINPUT
    wVk          As Integer
    wScan        As Integer
    dwFlags      As Long
    time         As Long
    dwExtraInfo  As LongPtr
    padding      As Currency
End Type

Private Type tagINPUT
    INPUTTYPE   As Long
    ki          As KEYBDINPUT
End Type

Public oDictCurEntries As Object, oDictUpdatedEntries As Object
Private bUpdate As Boolean


Public Sub AutomateStatusBar(ByVal Update As Boolean)
    Const WH_CBT = 5&, WM_MOUSEMOVE = &H200, WM_RBUTTONDOWN = &H204, WM_RBUTTONUP = &H205
    Dim hwnd As LongPtr, lHook As LongPtr, lp As Long
   
    On Error GoTo errHandler
    If oDictCurEntries Is Nothing Then
        Set oDictCurEntries = CreateObject("Scripting.Dictionary")
        Set oDictUpdatedEntries = CreateObject("Scripting.Dictionary")
    End If
    bUpdate = Update
    Call UnhookWindowsHookEx(GetProp(Application.hwnd, "Hook"))
    lHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, NULL_PTR, GetCurrentThreadId)
    Call SetProp(Application.hwnd, "Hook", lHook)
    If Not Application.CommandBars("Status Bar").Visible Then
        Application.CommandBars("Status Bar").Visible = True
    End If
    hwnd = FindWindowEx(Application.hwnd, NULL_PTR, "EXCEL2", vbNullString)
    hwnd = FindWindowEx(hwnd, NULL_PTR, "MsoCommandBar", "Status Bar")
    Call SetTopMost(Application.hwnd, True)
    lp = MAKELPARAM(1, 1)
    Call SendMessage(hwnd, WM_MOUSEMOVE, NULL_PTR, ByVal lp)
    Call SendMessage(hwnd, WM_RBUTTONDOWN, NULL_PTR, ByVal lp)
    Call SendMessage(hwnd, WM_RBUTTONUP, NULL_PTR, ByVal lp)
errHandler:
    Call UnhookWindowsHookEx(GetProp(Application.hwnd, "Hook"))
    Call SetTopMost(Application.hwnd, False)
    bUpdate = False
End Sub


'  __________________________________  PRIVATE HELPER ROUTINES _______________________________________

Private Function HookProc( _
    ByVal idHook As Long, _
    ByVal wParam As LongPtr, _
    ByVal lParam As LongPtr _
) As LongPtr

    Const HCBT_ACTIVATE = 5&
    Dim sBuff As String * 256&, lRet As Long
    Dim oAccSBarContextMenu As IAccessible, vAcc As Variant
   
    On Error Resume Next
    If idHook = HCBT_ACTIVATE Then
        lRet = GetClassName(wParam, sBuff, 256&)
        If Left(sBuff, lRet) = "Net UI Tool Window" Then
            Call UnhookWindowsHookEx(GetProp(Application.hwnd, "Hook"))
            Set oAccSBarContextMenu = HwndToAcc(wParam)
            Call AccessibleChildren(oAccSBarContextMenu, 3&, 1&, vAcc, 1&)
            Call ShowWindow(wParam, 0&)
            Call PressAltKey
            Call SearchAccChildren(vAcc)
        End If
    End If
    HookProc = CallNextHookEx(GetProp(Application.hwnd, "Hook"), idHook, ByVal wParam, ByVal lParam)
End Function

Private Sub SearchAccChildren(ByVal Acc As Variant)
    Dim oCUI As New CUIAutomation
    Dim oParentElement As IUIAutomationElement
    Dim oCondition As IUIAutomationCondition
    Dim oElement As IUIAutomationElement
    Dim oAllElementArray As IUIAutomationElementArray
    Dim i As Long, lNextDisplay As Long
   
    Set oParentElement = oCUI.ElementFromIAccessible(Acc, 0&)
    Set oCondition = oCUI.CreateTrueCondition
    Set oAllElementArray = oParentElement.FindAll(TreeScope_Children, oCondition)
    For i = 0& To oAllElementArray.Length - 1&
        Set oElement = oAllElementArray.GetElement(i)
        Call RecurseElements(oCUI, oElement, 0&, lNextDisplay)
    Next
End Sub
 
Private Sub RecurseElements( _
    ByVal oCUI As CUIAutomation, _
    ByVal oElement As IUIAutomationElement, _
    ByVal Level As Long, _
    ByRef NextDisplay As Long _
)
    Dim oCondition As IUIAutomationCondition
    Dim oAllElementArray As IUIAutomationElementArray
    Dim oSubElement As IUIAutomationElement
    Dim oIAccessiblePattern  As IUIAutomationLegacyIAccessiblePattern
    Dim oInvokePattern As IUIAutomationInvokePattern
    Dim oAccessible As IAccessible
    Dim lCurState As STATUSBAR_DISPLAY_CHECKED
    Dim bEnabled As Boolean, bUpdatedState As Boolean
    Dim i As Long
   
    Set oCondition = oCUI.CreateTrueCondition
    Set oAllElementArray = oElement.FindAll(TreeScope_Children, oCondition)
    For i = 0& To oAllElementArray.Length - 1&
        Set oSubElement = oAllElementArray.GetElement(i)
        If oElement.CurrentControlType = 50011 Then
            Set oIAccessiblePattern = oElement.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
            Set oAccessible = oIAccessiblePattern.GetIAccessible
            lCurState = oAccessible.accState(0&)
            On Error Resume Next
                oDictCurEntries.Add oElement.CurrentName, IIf(lCurState = Checked, True, False)
            On Error GoTo 0
            If bUpdate Then
                bUpdatedState = oDictUpdatedEntries.Items()(NextDisplay)
                Set oInvokePattern = oElement.GetCurrentPattern(UIA_InvokePatternId)
                Select Case lCurState
                    Case Is = Checked
                        If bUpdatedState = False Then
                            oInvokePattern.Invoke
                        End If
                    Case Is = Unchecked
                        If bUpdatedState = True Then
                            oInvokePattern.Invoke
                        End If
                End Select
            End If
            NextDisplay = NextDisplay + 1&
            Level = Level + 1&
        End If
        Call RecurseElements(oCUI, oSubElement, Level, NextDisplay)
    Next
End Sub

Private Function HwndToAcc(ByVal hwnd As LongPtr) As IAccessible
    Const ID_ACCESSIBLE As String = "{618736E0-3C3D-11CF-810C-00AA00389B71}"
    Const OBJID_WINDOW = 0&, S_OK = &H0&
    Dim tGUID(0& To 3&) As Long
    Dim oIAc As IAccessible
    hwnd = GetNextWindow(hwnd, 5&)
    If IIDFromString(StrPtr(ID_ACCESSIBLE), VarPtr(tGUID(0&))) = S_OK Then
        If AccessibleObjectFromWindow(hwnd, OBJID_WINDOW, VarPtr(tGUID(0&)), oIAc) = S_OK Then
           Set HwndToAcc = oIAc
        End If
    End If
End Function

Private Sub PressAltKey()
    Const KEYEVENTF_KEYUP = &H2, KEYEVENTF_UNICODE = &H4, VK_MENU = &H12
    ReDim InputArray(2&) As tagINPUT
    InputArray(0&).INPUTTYPE = 1&
    InputArray(0&).ki.wVk = VK_MENU
    InputArray(0&).ki.dwFlags = KEYEVENTF_UNICODE
    InputArray(1&).INPUTTYPE = 1&
    InputArray(1&).ki.wVk = VK_MENU
    InputArray(1&).ki.dwFlags = KEYEVENTF_UNICODE + KEYEVENTF_KEYUP
    Call SendInput(2&, InputArray(0&), LenB(InputArray(0&)))
End Sub

Private Sub SetTopMost(ByVal hwnd As LongPtr, ByVal bTopMost As Boolean)
    Const HWND_TOPMOST = -1, HWND_NOTOPMOST = -2, SWP_NOSIZE = &H1
    Const SWP_NOMOVE = &H2, SWP_SHOWWINDOW = &H40, SWP_ASYNCWINDOWPOS = &H4000
    DoEvents
    Call SetWindowPos(Application.hwnd, IIf(bTopMost, HWND_TOPMOST, HWND_NOTOPMOST), 0&, 0&, 0&, 0&, _
                      SWP_ASYNCWINDOWPOS + SWP_NOSIZE + SWP_SHOWWINDOW + SWP_NOMOVE)
End Sub

Private Function MAKELONG(wLow As Integer, wHigh As Integer) As Long
    MAKELONG = loword(wLow) Or (&H10000 * loword(wHigh))
End Function

Private Function MAKELPARAM(wLow As Integer, wHigh As Integer) As Long
    MAKELPARAM = MAKELONG(wLow, wHigh)
End Function

Private Function loword(ByVal Word As Long) As Integer
    Dim x As LongToInteger
    Call CopyMemory(x, Word, LenB(x))
    loword = x.Low
End Function

Private Function hiword(ByVal Word As Long) As Integer
    Dim x As LongToInteger
    Call CopyMemory(x, Word, LenB(x))
    hiword = x.High
End Function


2- CStatusBarEntries Class code:
VBA Code: 
Option Explicit
Option Base 1

Private oColEntries   As New Collection
Private vAllEntries() As Variant
Private vAllStates()  As Variant

Public Function Init(Optional bStart As Boolean = True) As Boolean
    Dim StatusBarEntry As CStatusBarEntry, lCounter As Long
    Set oDictCurEntries = Nothing
    Set oColEntries = Nothing
    Call AutomateStatusBar(Update:=False)
    With oDictCurEntries
        If .Count Then
            ReDim vAllEntries(.Count)
            ReDim vAllStates(.Count)
            For lCounter = 1& To .Count
                Set StatusBarEntry = New CStatusBarEntry
                vAllEntries(lCounter) = .Keys()(lCounter - 1&)
                vAllStates(lCounter) = .Items()(lCounter - 1&)
                StatusBarEntry.Name = vAllEntries(lCounter)
                StatusBarEntry.Enabled = vAllStates(lCounter)
                Call oColEntries.Add(Item:=StatusBarEntry, Key:=StatusBarEntry.Name)
            Next
            Init = True
            If bStart = False Then
                MsgBox "Excel StatusBar update successfully completed."
            End If
        End If
    End With
End Function

Public Property Get Item(vItem As Variant) As CStatusBarEntry
   Set Item = oColEntries(vItem)
End Property

Public Property Get Count() As Long
   Count = UBound(vAllEntries)
End Property

Public Function NamesArrayList() As Variant()
    NamesArrayList = vAllEntries
End Function

Public Sub Update()
    Dim StatusBarEntry As CStatusBarEntry
    Dim i As Long
    oDictUpdatedEntries.RemoveAll
    For Each StatusBarEntry In oColEntries
        oDictUpdatedEntries.Add oDictCurEntries.Keys()(i), StatusBarEntry.Enabled
        i = i + 1&
    Next StatusBarEntry
    Call AutomateStatusBar(Update:=True)
    Call Init(bStart:=False)
End Sub

Public Sub EnableAll()
    Dim StatusBarEntry As CStatusBarEntry
    For Each StatusBarEntry In oColEntries
        StatusBarEntry.Enabled = True
    Next
    Call Me.Update
End Sub

Public Sub DisableAll()
    Dim StatusBarEntry As CStatusBarEntry
    For Each StatusBarEntry In oColEntries
        StatusBarEntry.Enabled = False
    Next
    Call Me.Update
End Sub

Public Function NewEnum() As IUnknown
    'Attribute NewEnum.VB_UserMemID = -4
    Set NewEnum = oColEntries.[_NewEnum]
End Function


3- CStatusBarEntry Class code:
VBA Code: 
Option Explicit

Private sName As String, bState As Boolean

Public Property Get Name() As String
    'Attribute Value.VB_UserMemId = 0
    Name = sName
End Property

Friend Property Let Name(ByVal vNewValue As String)
    sName = vNewValue
End Property

Public Property Get Enabled() As Boolean
    Enabled = bState
End Property

Public Property Let Enabled(ByVal vNewValue As Boolean)
    bState = vNewValue
End Property


4- Code Usage example in the UserForm Module:
VBA Code: 
Option Explicit

Private StatusBarEntries As CStatusBarEntries

Private Sub UserForm_Initialize()
    Set StatusBarEntries = New CStatusBarEntries
    If StatusBarEntries.Init = False Then GoTo errHandler
    Call RefreshListBox
    Exit Sub
errHandler:
    MsgBox "Failed to initiate the StatusBar Automation." & vbNewLine & vbNewLine & _
           "There is probably a TopMost window obscuring the Excel StatusBar.", vbCritical, "Error!"
    End
End Sub

Private Sub btnUpdate_Click()
    Dim i As Long
    For i = 1& To StatusBarEntries.Count
        StatusBarEntries.Item(i).Enabled = ListBox.Selected(i - 1&)
    Next
    StatusBarEntries.Update
    Call RefreshListBox
End Sub

Private Sub btn_EnableAll_Click()
    StatusBarEntries.EnableAll
    Call RefreshListBox
End Sub

Private Sub btnDisableAll_Click()
    StatusBarEntries.DisableAll
    Call RefreshListBox
End Sub

Private Sub RefreshListBox()
    Dim StatusBarEntry As CStatusBarEntry, lCounter As Long
    With ListBox
        .Clear
        .List = StatusBarEntries.NamesArrayList
        For Each StatusBarEntry In StatusBarEntries
            If StatusBarEntry.Enabled Then
                .Selected(lCounter) = True
            End If
            lCounter = lCounter + 1&
        Next
    End With
End Sub



A couple of notes:
1- The project needs a reference to the UIAutomationClient library (UIAutomationCore.dll)
2- If a userform is used as interface for automating the excel statusbar (just like I did here), the userform must be shown Modeless.
3- Both Classes have a member attribute set :
Attribute NewEnum.VB_UserMemID = -4 (in class CStatusBarEntries) and Attribute Value.VB_UserMemId = 0 (in class CStatusBarEntry)
So if anyone copies the Classes codes above for their own project, the above attributes must first be set, then the class modules must be exported (say to notepad as .cls files) and then imported back to the project.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question
Show the "Edit Name" dialog from VBA for a specific Name
Replies
1
Views
375
Jaafar Tribak
Jaafar Tribak
gallen
  • Question
Macro Enabled Workbooks Suddenly Corrupting Regularly.
Replies
5
Views
1K
Joe4
Joe4
W
  • Question
Custom functions on Excel Right-click menu (not working)
Replies
0
Views
136
wheelsguy
W
I
  • Question
Move multiple rows from one table to another using conditional trigger
Replies
2
Views
481
ItsNursinTime
I
A
  • Solved
Comparing two excel files for matching / mismatching rows (long text strings - match() wont work
Replies
4
Views
568
ahaye
A

Forum statistics

Threads
1,215,214
Messages
6,123,661
Members
449,114
Latest member
aides

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