Excel Screen Reader Upon Navigating With The Mouse (with VBA alone)

Jaafar Tribak

Jaafar Tribak

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

This is an attempt to simulate the Windows built-in screen-reader narrator but, done with vba alone.
The code is supposed to read-back the type of object currently under the mouse pointer and, if applicable, to read the object caption\text\value as well.

The code lets you choose a voice\language from the ones installed in your machine via a userform.

File demo:
ObjectToSpeech.xls



1- API code (Standard Module)
VBA Code: 
Option Explicit

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

#If VBA7 Then

    #If Win64 Then
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal arg1 As LongLong, ppacc As Any, pvarChild As Variant) As Long
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
        Private Declare PtrSafe Function Currency_GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As Currency) As Long
    #Else
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    #End If
    Private Declare PtrSafe Function Pnt_GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
    Private Declare PtrSafe Function StringFromGUID2 Lib "ole32" (ByRef rguid As GUID, ByVal lpsz As LongPtr, ByVal cchMax As Long) As Long
    Private Declare PtrSafe Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As LongPtr, ByRef cGUID As GUID) As Long
    Private Declare PtrSafe Function CoCreateInstance Lib "ole32" (ByRef rclsid As GUID, ByVal pUnkOuter As LongPtr, ByVal dwClsContext As Long, ByRef riid As GUID, ByRef ppv As LongPtr) As Long
    Private Declare PtrSafe Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
    Private Declare PtrSafe Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)
    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 GetForegroundWindow Lib "user32" () As LongPtr
    
    Private pAutomation As LongPtr

#Else
    Private Declare Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    Private Declare Function Pnt_GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long
    Private Declare Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long
    Private Declare Function StringFromGUID2 Lib "ole32" (ByRef rguid As GUID, ByVal lpsz As Long, ByVal cchMax As Long) As Long
    Private Declare Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As Long, ByRef cGUID As GUID) As Long
    Private Declare Function CoCreateInstance Lib "ole32" (ByRef rclsid As GUID, ByVal pUnkOuter As Long, ByVal dwClsContext As Long, ByRef riid As GUID, ByRef ppv As Long) As Long
    Private Declare Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
    Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode 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 GetForegroundWindow Lib "user32" () As Long
    
    Private pAutomation As Long

#End If
        
Private oVoices As Object

        
        
Sub StartObjectToSpeech()

    With Application
        If Not IsError(.ExecuteExcel4Macro("DontShowAgain")) Then
            GoTo Start
        End If
        UFVoices.Show vbModal
        If .ExecuteExcel4Macro("Voice") = -1& Then
            Exit Sub
        End If
Start:
        pAutomation = -1
        Call KillTimer(.hwnd, 0)
        Call SetTimer(.hwnd, 0, 0, AddressOf SpeakObjectUnderMouse)
    End With
    
End Sub

Sub FinishObjectToSpeech()

    If Not oVoices Is Nothing Then
        Call TextToSpeech(vbNullString, 0, 0)
        Set oVoices = Nothing
    End If
    
    Call KillTimer(Application.hwnd, 0)

End Sub

Private Sub TextToSpeech(ByVal Text As String, ByVal Rate As Long, ByVal Volume As Long)

    Set oVoices = CreateObject("SAPI.SpVoice")
    With oVoices
        Set .Voice = .GetVoices.Item(Application.ExecuteExcel4Macro("Voice"))
        .Rate = Rate
        .Volume = Volume
        .Speak Text, 1
    End With

End Sub

Private Sub Refresh_DontShowAgain()
    Application.ExecuteExcel4Macro "SET.NAME(""DontShowAgain"")"
End Sub


Private Sub SpeakObjectUnderMouse()

    Const IID_CUIAUTOMATION = "{FF48DBA4-60EF-4201-AA87-54103EEF594E}"
    Const IID_IUIAUTOMATION = "{30CBE57D-D9D0-452A-AB13-7AC5AC4825EE}"
    Const CLSCTX_INPROC_SERVER = &H1
    Const CC_STDCALL = 4&
    
    #If Win64 Then
        Const PTR_LEN = 8&
    #Else
        Const PTR_LEN = 4&
    #End If

    #If Win64 Then
        Dim pElement As LongLong
        Dim pCurrentName As LongLong
        Dim pClassName As LongLong
        Dim pHelpText As LongLong
        Dim pLocalisedCtrlType As LongLong
    #Else
        Dim pElement As Long
        Dim pCurrentName As Long
        Dim pClassName As Long
        Dim pHelpText As Long
        Dim pLocalisedCtrlType As Long
    #End If

    Static sPrevCurrentName As String
    Static sPrevAccName As String
    Static sPrevTmpText As String

    Dim sCurrentName As String
    Dim sClassName As String
    Dim sHelpText As String
    Dim sLocalisedCtrlType As String
    Dim sAccName As String
    Dim sTmpText As String
    Dim oIAcc As IAccessible, vKid As Variant
    Dim iidCuiAuto As GUID, iidIuiAuto As GUID
    Dim lRet As Long, vtblOffset As Long
    Dim tCurPos_PNT As POINTAPI, tCurPos_Currency As Currency
    Dim oObjUnderMouse As Object
    
    On Error Resume Next
    Application.EnableCancelKey = xlDisabled
    
    If pAutomation = 0 Then
        Call KillTimer(Application.hwnd, 0): Call Refresh_DontShowAgain: Exit Sub  ' If error Cancel timer & Get Out !
    End If
    
    If pAutomation = 0 Xor pAutomation = -1 Then
        lRet = CLSIDFromString(StrPtr(IID_CUIAUTOMATION), iidCuiAuto)
        Call DispGUID(iidCuiAuto)
        lRet = CLSIDFromString(StrPtr(IID_IUIAUTOMATION), iidIuiAuto)
        Call DispGUID(iidIuiAuto)
        lRet = CoCreateInstance(iidCuiAuto, 0, CLSCTX_INPROC_SERVER, iidIuiAuto, pAutomation)
        If lRet <> 0 Then MsgBox "Automation failed.": Exit Sub
    End If

    Call Pnt_GetCursorPos(tCurPos_PNT)
    Set oObjUnderMouse = Application.ActiveWindow.RangeFromPoint(tCurPos_PNT.x, tCurPos_PNT.y)
    
    vtblOffset = 7 * PTR_LEN ' IUIAutomation::ElementFromPoint 28 * PTR_LEN
    #If Win64 Then
        Call Currency_GetCursorPos(tCurPos_Currency)
        Call vtblCall(pAutomation, vtblOffset, vbLong, CC_STDCALL, tCurPos_Currency, VarPtr(pElement))
    #Else
        Call vtblCall(pAutomation, vtblOffset, vbLong, CC_STDCALL, tCurPos_PNT.x, tCurPos_PNT.y, VarPtr(pElement))
    #End If
    
    vtblOffset = 23 * PTR_LEN   ' IUIAutomationElement::CurrentName
    Call vtblCall(pElement, vtblOffset, vbLong, CC_STDCALL, VarPtr(pCurrentName))
    vtblOffset = 30 * PTR_LEN  ' IUIAutomationElement::CurrentClassName
    Call vtblCall(pElement, vtblOffset, vbLong, CC_STDCALL, VarPtr(pClassName))
    sClassName = GetStrFromPtrW(pClassName)
    
    If TypeName(oObjUnderMouse) = "Nothing" Or InStr(sClassName, "Net") Then
        vtblOffset = 31 * PTR_LEN  ' IUIAutomationElement::CurrentHelpText
        Call vtblCall(pElement, vtblOffset, vbLong, CC_STDCALL, VarPtr(pHelpText))
        vtblOffset = 22 * PTR_LEN  ' IUIAutomationElement::CurrentLocalisedControlType
        Call vtblCall(pElement, vtblOffset, vbLong, CC_STDCALL, VarPtr(pLocalisedCtrlType))
        sCurrentName = GetStrFromPtrW(pCurrentName)
        sHelpText = GetStrFromPtrW(pHelpText)
        sLocalisedCtrlType = GetStrFromPtrW(pLocalisedCtrlType)
        #If Win64 Then
            Dim Ptr As LongLong
            Call CopyMemory(Ptr, tCurPos_PNT, LenB(tCurPos_PNT))
            Call AccessibleObjectFromPoint(Ptr, oIAcc, vKid)
        #Else
            Call AccessibleObjectFromPoint(tCurPos_PNT.x, tCurPos_PNT.y, oIAcc, vKid)
        #End If
        sAccName = oIAcc.accName(0&)
        If sAccName <> sPrevAccName Or sCurrentName <> sPrevCurrentName Then
            If sAccName = sCurrentName Then
                sTmpText = sAccName
            Else
                sTmpText = sAccName & ". " & sCurrentName
            End If
            If sLocalisedCtrlType = sHelpText Then
                sTmpText = sLocalisedCtrlType & ". " & sTmpText
            Else
                sTmpText = sLocalisedCtrlType & ". " & sHelpText & ". " & sTmpText
            End If
            GoTo SpeakText
        End If
    Else
        sTmpText = BuildStringDescriptionFromObjectWithinSheet(oObjUnderMouse)
        If sTmpText <> sPrevTmpText Then
            GoTo SpeakText
        End If
    End If
    
    GoTo Xit
    
SpeakText:
    Call TextToSpeech(sTmpText, 0, 100)
    
Xit:

    If pElement Then
        vtblOffset = 2 * PTR_LEN  ' IUIAutomationElement::Release
        Call vtblCall(pElement, vtblOffset, vbLong, CC_STDCALL)
    End If
    
    sPrevAccName = sAccName
    sPrevCurrentName = sCurrentName
    sPrevTmpText = sTmpText

End Sub

Private Function BuildStringDescriptionFromObjectWithinSheet(ByVal ObjUnderMouse As Object) As String
    
    Dim sCell As String, sFormula As String, sValue As String, sContains As String
    Dim sHyperLink As String, sFalse As String, sTrue As String, sAddress As String
    Dim sMinus As String, sPlus  As String, sTimes  As String, sDividedBy  As String
    Dim sGreater As String, sLess  As String, sNotEqual  As String
    Dim sGreaterOrEqual As String, sLessOrEqual  As String
    Dim sTmpText As String

    On Error Resume Next
    With oVoices
        Select Case True
            Case InStr(.Voice.GetDescription, "English")
                sCell = "Cell": sFormula = "Formula": sValue = "Value": sContains = "Contains"
                sHyperLink = "Hyperlink": sFalse = "False": sTrue = "True": sAddress = "address"
                sMinus = "minus": sPlus = "plus": sTimes = "multiplied by": sDividedBy = "Divided. by"
                sGreater = "greater than": sLess = "less than": sNotEqual = "not equal to"
                sGreaterOrEqual = "greater Or equal to": sLessOrEqual = "less or equal to"
            Case InStr(.Voice.GetDescription, "Spanish")
                sCell = "Celda": sFormula = "Formula": sValue = "Valor": sContains = "Contiene"
                sHyperLink = "Hiper Enlace": sFalse = "Falso": sTrue = "Verdadero": sAddress = "direccion"
                'some rudimentary arithmetic operators translations into Spanish ..(+/*-<>...)... might need to be extended.
                sMinus = "menos": sPlus = "mas": sTimes = "multiplicado por": sDividedBy = "dividido por"
                sGreater = "mayor que": sLess = "menor que": sNotEqual = "distinto de"
                sGreaterOrEqual = "mayor o igual que ": sLessOrEqual = "menor o igual que"
            Case InStr(.Voice.GetDescription, "French")
                sCell = "Cellule": sFormula = "Formule": sValue = "Valeur": sContains = "Contien"
                sHyperLink = "Lien HyperTexte": sFalse = "Faux": sTrue = "Vrai": sAddress = "adresse"
                'some rudimentary arithmetic operators translation into French ..(+/*-<>...)... might need to be extended.
                sMinus = "moins": sPlus = "plus": sTimes = "multiplié par": sDividedBy = "divisé par"
                sGreater = "superieur a": sLess = "inferieur a": sNotEqual = "different de"
                sGreaterOrEqual = "supérieur ou égal à": sLessOrEqual = "inférieur ou égal à"
        End Select
    End With

    If TypeName(ObjUnderMouse) = "Range" Then
        If Not IsEmpty(ObjUnderMouse) Then
            sTmpText = sCell & ObjUnderMouse.Address(False, False)
            If ObjUnderMouse.HasFormula Then
            sTmpText = sTmpText & ". " & sContains & sFormula & ". " & ObjUnderMouse.Formula
            sTmpText = Replace(sTmpText, "-", sMinus)
            sTmpText = Replace(sTmpText, "+", sPlus)
            sTmpText = Replace(sTmpText, "*", sTimes)
            sTmpText = Replace(sTmpText, "/", sDividedBy)
            sTmpText = Replace(sTmpText, "<>", sNotEqual)
            sTmpText = Replace(sTmpText, ">=", sGreaterOrEqual)
            sTmpText = Replace(sTmpText, "<=", sLessOrEqual)
            sTmpText = Replace(sTmpText, "<", sLess)
            sTmpText = Replace(sTmpText, ">", sGreater)
            End If
            If HasHyperLink(ObjUnderMouse) Then
                sTmpText = sTmpText & ". " & sHyperLink & ". " & sAddress & _
                ObjUnderMouse.Hyperlinks(1).SubAddress & ObjUnderMouse.Hyperlinks(1).Address
            End If
            If HasHyperLink(ObjUnderMouse) = False Then
                sTmpText = sTmpText & ". " & sValue & ". " & ObjUnderMouse.Value
                sTmpText = Replace(sTmpText, False, sFalse)
                sTmpText = Replace(sTmpText, True, sTrue)
            End If
        Else
            TextToSpeech vbNullString, 0, 0
        End If
    End If

    If TypeName(ObjUnderMouse) = "OLEObject" Then
        sTmpText = ObjUnderMouse.Name
        If ObjUnderMouse.Name <> ObjUnderMouse.Object.Caption Then
            sTmpText = sTmpText & ". " & ObjUnderMouse.Object.Caption
        End If
        If InStr(TypeName(ObjUnderMouse.Object), "CommandButton") = 0 And _
        InStr(TypeName(ObjUnderMouse.Object), "ToggleButton") = 0 Then
            sTmpText = sTmpText & ". " & ObjUnderMouse.Object.Value
            sTmpText = Replace(sTmpText, False, sFalse)
            sTmpText = Replace(sTmpText, True, sTrue)
        End If
    ElseIf TypeName(ObjUnderMouse) <> "Range" Then
        sTmpText = ObjUnderMouse.Name
        If ObjUnderMouse.Name <> ObjUnderMouse.Caption Then
            sTmpText = sTmpText & ".  " & ObjUnderMouse.Caption
        End If
        If TypeName(ObjUnderMouse) = "CheckBox" Or TypeName(ObjUnderMouse) = "OptionButton" Then
            If ObjUnderMouse = -4146 Then
                sTmpText = sTmpText & ". " & sFalse
            Else
                sTmpText = sTmpText & ". " & sTrue
            End If
        End If
    sTmpText = sTmpText & ". " & ObjUnderMouse.List(ObjUnderMouse.ListIndex)
    End If

    BuildStringDescriptionFromObjectWithinSheet = sTmpText

End Function
    
#If Win64 Then
    Private Function vtblCall(ByVal InterfacePointer As LongLong, ByVal VTableOffset As Long, ByVal FunctionReturnType As Long, ByVal CallConvention As Long, ParamArray FunctionParameters() As Variant) As Variant
        Dim vParamPtr() As LongLong
#Else
    Private Function vtblCall(ByVal InterfacePointer As Long, ByVal VTableOffset As Long, ByVal FunctionReturnType As Long, ByVal CallConvention As Long, ParamArray FunctionParameters() As Variant) As Variant
        Dim vParamPtr() As Long
#End If
    
    Dim pIndex As Long, pCount As Long
    Dim vParamType() As Integer
    Dim vRtn As Variant, vParams() As Variant

    vParams() = FunctionParameters()
    pCount = Abs(UBound(vParams) - LBound(vParams) + 1&)
    If pCount = 0& Then
        ReDim vParamPtr(0 To 0)
        ReDim vParamType(0 To 0)
    Else
        ReDim vParamPtr(0 To pCount - 1&)
        ReDim vParamType(0 To pCount - 1&)
        For pIndex = 0& To pCount - 1&
            vParamPtr(pIndex) = VarPtr(vParams(pIndex))
            vParamType(pIndex) = VarType(vParams(pIndex))
        Next
    End If

     pIndex = DispCallFunc(InterfacePointer, VTableOffset, CallConvention, FunctionReturnType, pCount, vParamType(0), vParamPtr(0), vRtn)

    If pIndex = 0& Then
        vtblCall = vRtn
    Else
        Call SetLastError(pIndex)
    End If
End Function

#If Win64 Then
    Private Function GetStrFromPtrW(ByVal Ptr As LongLong) As String
#Else
    Private Function GetStrFromPtrW(ByVal Ptr As Long) As String
#End If
    Call SysReAllocString(VarPtr(GetStrFromPtrW), Ptr)
End Function

Private Sub DispGUID(objGuid As GUID)
    Dim lRet As Long
    Dim sTmp As String
    Dim buf(100) As Byte
    
    lRet = StringFromGUID2(objGuid, VarPtr(buf(0)), UBound(buf) - 1)
    sTmp = buf
End Sub

Private Function HasHyperLink(ByVal oRng As Range) As Boolean
    HasHyperLink = CBool(oRng.Hyperlinks.Count)
End Function

Private Sub Auto_Close()
    Call KillTimer(Application.hwnd, 0)
End Sub



2- UserForm Module:
VBA Code: 
Option Explicit

Private Sub UserForm_Initialize()

    Dim oVoice As Object, i As Long

    'Populate ListBox with installed voices.
    Set oVoice = CreateObject("SAPI.SpVoice")
    With oVoice
        If .GetVoices.Count Then
            For i = 0 To .GetVoices.Count - 1
                Set .Voice = .GetVoices.Item(i)
                Me.ListBox1.AddItem .Voice.GetDescription
            Next i
            Me.ListBox1.Selected(0) = True
        Else
            Call SetName("Voice", -1&)
            MsgBox "No Voices Installed."
            Unload Me
        End If
    End With

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    On Error Resume Next

    'UserForm Cancelled.
    If Application.ExecuteExcel4Macro("Voice") = -1& Or CloseMode = 0 Then
        Call SetName("Voice", -1&)
        Exit Sub
    End If

    'Don't show Voices Form again.
    If Me.CheckBox1.Value Then
        Call SetName("DontShowAgain", -1&)
    End If

End Sub

Private Sub CommandButton1_Click()
    Call SetName("Voice", CLng(ListBox1.ListIndex))
    Unload Me
End Sub

Private Sub CommandButton2_Click()
    Call SetName("Voice", -1&)
    Unload Me
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
     Call SetName("Voice", CLng(ListBox1.ListIndex))
    Unload Me
End Sub

Private Sub SetName(ByVal sName As String, ByVal sValue As Long)
    Application.ExecuteExcel4Macro "SET.NAME(" & Chr(34) & sName & Chr(34) & "," & sValue & ")"
End Sub


Tested on excel 2010/2016 x32 and x64 (excel 2007 might give erroneous results when applied to shapes)
 
Last edited:

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
impressive work!! I tested it's very nice thanks Jaafar ;)
 
Upvote 0
MKLAQ said:
impressive work!! I tested it's very nice thanks Jaafar ;)
Click to expand...

MKLAQ​

Thanks for testing and for the feedback.

Could you do me the favor of telling me which version of excel (including its Bitness ie: x32bit or x64bit) you tried the code on ?
And which language\voice did you choose ? English, French or Spanish ?

I am asking because I have tested the code only on an English edition of excel and I am curious to know how the code behaves in the French & Spanish editions .
 
Upvote 0
@Jaafar Tribak your works always are unique I also tested is awesome
my windows is 10 system 64 bit the language is Arabic and excel 2016
thanks for a great file ;)
best regards,
abdelfattah
 
Upvote 0
MKLAQ said:
@Jaafar Tribak my windows is 10 64 bit and excel 2016 is English :)
Click to expand...
Thanks for letting me know.

I have discovered a couple of stealth logical bugs in the code (namely the code keeps working outside excel which can cause some unwanted behaviour + I should also store the voice attributes somewhere other than in an application Hidden-Name which is preventing the voice\reader from working when a dialogbox is on display )

I will post back with an update tomorrow.

Regards.
 
Upvote 0
Ok- Back with the update :

- Works with excel DialogBoxes, userforms, popups, context menus and ribbon drop menus.
- The user can choose between local use (Excel only) or global use.
- Works on multiple workbooks (Less accurate results in workbooks opened in seperate xl instances)
- Safe exit, should an accidental loss of state occur while the timer is running.

Updated File Demo:
ObjectToSpeech.xls



1- API code (Standard Module)
VBA Code: 
Option Explicit

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

#If VBA7 Then

    #If Win64 Then
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal arg1 As LongLong, ppacc As Any, pvarChild As Variant) As Long
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
        Private Declare PtrSafe Function Currency_GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As Currency) As Long
    #Else
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    #End If
    Private Declare PtrSafe Function Pnt_GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
    Private Declare PtrSafe Function StringFromGUID2 Lib "ole32" (ByRef rguid As GUID, ByVal lpsz As LongPtr, ByVal cchMax As Long) As Long
    Private Declare PtrSafe Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As LongPtr, ByRef cGUID As GUID) As Long
    Private Declare PtrSafe Function CoCreateInstance Lib "ole32" (ByRef rclsid As GUID, ByVal pUnkOuter As LongPtr, ByVal dwClsContext As Long, ByRef riid As GUID, ByRef ppv As LongPtr) As Long
    Private Declare PtrSafe Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
    Private Declare PtrSafe Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)
    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 GetCurrentProcessId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
    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 pAutomation As LongPtr

#Else
    Private Declare Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    Private Declare Function Pnt_GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long
    Private Declare Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long
    Private Declare Function StringFromGUID2 Lib "ole32" (ByRef rguid As GUID, ByVal lpsz As Long, ByVal cchMax As Long) As Long
    Private Declare Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As Long, ByRef cGUID As GUID) As Long
    Private Declare Function CoCreateInstance Lib "ole32" (ByRef rclsid As GUID, ByVal pUnkOuter As Long, ByVal dwClsContext As Long, ByRef riid As GUID, ByRef ppv As Long) As Long
    Private Declare Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
    Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode 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 GetCurrentProcessId Lib "kernel32" () As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
    Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
    
    Private pAutomation As Long

#End If
        
Private oVoices As Object
      
      
      
'___________________________________PUBLIC ROUTINES_______________________________________________

Public Sub StartObjectToSpeech()
    If GetProps("DontShowAgain") Then
            GoTo Start
        End If
        UFVoices.Show vbModal
            If GetProps("Voice") = -1& Then
            Exit Sub
        End If
Start:
        pAutomation = -1
        Call KillTimer(AppHwnd, 0)
        Call SetTimer(AppHwnd, 0, 0, AddressOf SpeakObjectUnderMouse)
End Sub

Public Sub FinishObjectToSpeech()
    If Not oVoices Is Nothing Then
        Call TextToSpeech(vbNullString, 0, 0)
        Set oVoices = Nothing
    End If
    Call KillTimer(AppHwnd, 0)
End Sub

Public Sub SetProps(ByVal sName As String, ByVal lValue As Long)
    Call SetProp(AppHwnd, sName, lValue)
End Sub

Public Function GetProps(ByVal sName As String) As Long
    GetProps = CLng(GetProp(AppHwnd, sName))
End Function


#If Win64 Then
    Public Property Get AppHwnd() As LongLong
#Else
    Public Property Get AppHwnd() As Long
#End If
        AppHwnd = GetProp(GetDesktopWindow, "AppHwd")
End Property

#If Win64 Then
    Public Property Let AppHwnd(ByVal hwnd As LongLong)
#Else
    Public Property Let AppHwnd(ByVal hwnd As Long)
#End If
        Call SetProp(GetDesktopWindow, "AppHwd", hwnd)
End Property




'___________________________________PRIVATE ROUTINES_______________________________________________

Private Sub TextToSpeech(ByVal Text As String, ByVal Rate As Long, ByVal Volume As Long)
    Set oVoices = CreateObject("SAPI.SpVoice")
    With oVoices
        Set .Voice = .GetVoices.Item(GetProps("Voice"))
        .Rate = Rate
        .Volume = Volume
        .Speak Text, 1
    End With
End Sub

Private Sub Reset()
    Call KillTimer(AppHwnd, 0)
    Call SetProps("DontShowAgain", 0)
    Call SetProps("GlobalScope", 0)
    Call TextToSpeech(vbNullString, 0, 0)
    Set oVoices = Nothing
End Sub

Private Sub SpeakObjectUnderMouse()

    Const IID_CUIAUTOMATION = "{FF48DBA4-60EF-4201-AA87-54103EEF594E}"
    Const IID_IUIAUTOMATION = "{30CBE57D-D9D0-452A-AB13-7AC5AC4825EE}"
    Const CLSCTX_INPROC_SERVER = &H1
    Const CC_STDCALL = 4&
    Const S_OK = 0&
    Const HWND_TOPMOST = -1
    Const WS_EX_TOPMOST = &H8&
    Const GWL_EXSTYLE = -20
    
    #If Win64 Then
        Const PTR_LEN = 8&
    #Else
        Const PTR_LEN = 4&
    #End If

    #If Win64 Then
        Dim pElement As LongLong
        Dim pCurrentName As LongLong
        Dim pHelpText As LongLong
        Dim pLocalisedCtrlType As LongLong
        Dim pProcessID As LongLong
    #Else
        Dim pElement As Long
        Dim pCurrentName As Long
        Dim pHelpText As Long
        Dim pLocalisedCtrlType As Long
        Dim pProcessID As Long
    #End If

    Static sPrevCurrentName As String
    Static sPrevAccName As String
    Static sPrevTmpText As String
    
    Dim sCurrentName As String
    Dim sHelpText As String
    Dim sLocalisedCtrlType As String
    Dim sAccName As String
    Dim sTmpText As String
    Dim sClassName As String
    Dim sBuff As String * 256
    Dim lProcessID As Long
    Dim oIAcc As IAccessible, vKid As Variant
    Dim iidCuiAuto As GUID, iidIuiAuto As GUID
    Dim lRet As Long, vtblOffset As Long
    Dim tCurPos_PNT As POINTAPI, tCurPos_Currency As Currency
    Dim oObjUnderMouse As Object    
    
    On Error Resume Next
    Application.EnableCancelKey = xlDisabled
    
    'Reset & get out if loss of state !
    If pAutomation = 0 Then
        Call Reset: Exit Sub
    End If
    
    If pAutomation = 0 Xor pAutomation = -1 Then
        lRet = CLSIDFromString(StrPtr(IID_CUIAUTOMATION), iidCuiAuto)
        Call DispGUID(iidCuiAuto)
        lRet = CLSIDFromString(StrPtr(IID_IUIAUTOMATION), iidIuiAuto)
        Call DispGUID(iidIuiAuto)
        lRet = CoCreateInstance(iidCuiAuto, 0, CLSCTX_INPROC_SERVER, iidIuiAuto, pAutomation)
        If lRet <> S_OK Then MsgBox "Automation failed.": Exit Sub
    End If

    Call Pnt_GetCursorPos(tCurPos_PNT)
    
    vtblOffset = 7 * PTR_LEN ' IUIAutomation::ElementFromPoint
    #If Win64 Then
        Call Currency_GetCursorPos(tCurPos_Currency)
        lRet = vtblCall(pAutomation, vtblOffset, vbLong, CC_STDCALL, tCurPos_Currency, VarPtr(pElement))
    #Else
        lRet = vtblCall(pAutomation, vtblOffset, vbLong, CC_STDCALL, tCurPos_PNT.x, tCurPos_PNT.y, VarPtr(pElement))
    #End If
    
   If lRet <> S_OK Then GoTo MSAA_SECTION
  
    vtblOffset = 20 * PTR_LEN  ' IUIAutomationElement::CurrentProcessID
    Call vtblCall(pElement, vtblOffset, vbLong, CC_STDCALL, VarPtr(lProcessID))
        
    If GetProps("GlobalScope") = 0& Then
        If GetCurrentProcessId <> lProcessID Then
            Call TextToSpeech(vbNullString, 0, 0)
            GoTo Xit
        End If
    End If
    
    Set oObjUnderMouse = Application.ActiveWindow.RangeFromPoint(tCurPos_PNT.x, tCurPos_PNT.y)
        
       lRet = GetClassName(GetActiveWindow, sBuff, 256)
       sClassName = Left(sBuff, lRet)
          
    If TypeName(oObjUnderMouse) = "Nothing" Or sClassName <> "XLMAIN" Then
    
        vtblOffset = 23 * PTR_LEN   ' IUIAutomationElement::CurrentName
        Call vtblCall(pElement, vtblOffset, vbLong, CC_STDCALL, VarPtr(pCurrentName))
        vtblOffset = 31 * PTR_LEN  ' IUIAutomationElement::CurrentHelpText
        Call vtblCall(pElement, vtblOffset, vbLong, CC_STDCALL, VarPtr(pHelpText))
        vtblOffset = 22 * PTR_LEN  ' IUIAutomationElement::CurrentLocalisedControlType
        Call vtblCall(pElement, vtblOffset, vbLong, CC_STDCALL, VarPtr(pLocalisedCtrlType))
        sCurrentName = GetStrFromPtrW(pCurrentName)
        sHelpText = GetStrFromPtrW(pHelpText)
        sLocalisedCtrlType = GetStrFromPtrW(pLocalisedCtrlType)
        #If Win64 Then
            Dim Ptr As LongLong
            Call CopyMemory(Ptr, tCurPos_PNT, LenB(tCurPos_PNT))
            Call AccessibleObjectFromPoint(Ptr, oIAcc, vKid)
        #Else
            Call AccessibleObjectFromPoint(tCurPos_PNT.x, tCurPos_PNT.y, oIAcc, vKid)
        #End If
        sAccName = oIAcc.accName(0&)
        If sAccName <> sPrevAccName Or sCurrentName <> sPrevCurrentName Then
            If sAccName = sCurrentName Then
                sTmpText = sAccName
            Else
                sTmpText = sAccName & ". " & sCurrentName
            End If
            If sLocalisedCtrlType = sHelpText Then
                sTmpText = sLocalisedCtrlType & ". " & sTmpText
            Else
                sTmpText = sLocalisedCtrlType & ". " & sHelpText & ". " & sTmpText
            End If
            GoTo SpeakText
        End If
    Else
    
MSAA_SECTION:

        sTmpText = BuildStringDescriptionFromObjectWithinSheet(oObjUnderMouse)
        If sTmpText <> sPrevTmpText Then
            GoTo SpeakText
        End If
        
    End If
    
    GoTo Xit
    
SpeakText:

    Call TextToSpeech(sTmpText, 0, 100)
    
Xit:

    If pElement Then
        vtblOffset = 2 * PTR_LEN  ' IUIAutomationElement::Release
        Call vtblCall(pElement, vtblOffset, vbLong, CC_STDCALL)
    End If
    
    sPrevAccName = sAccName
    sPrevCurrentName = sCurrentName
    sPrevTmpText = sTmpText

End Sub


Private Function BuildStringDescriptionFromObjectWithinSheet(ByVal ObjUnderMouse As Object) As String
    
    Dim sCell As String, sFormula As String, sValue As String, sContains As String
    Dim sHyperLink As String, sFalse As String, sTrue As String, sAddress As String
    Dim sMinus As String, sPlus  As String, sTimes  As String, sDividedBy  As String
    Dim sGreater As String, sLess  As String, sNotEqual  As String
    Dim sGreaterOrEqual As String, sLessOrEqual  As String
    Dim sTmpText As String

    On Error Resume Next
    With oVoices
        Select Case True
            Case InStr(.Voice.GetDescription, "English")
                sCell = "Cell": sFormula = "Formula": sValue = "Value": sContains = "Contains"
                sHyperLink = "Hyperlink": sFalse = "False": sTrue = "True": sAddress = "address"
                sMinus = "minus": sPlus = "plus": sTimes = "multiplied by": sDividedBy = "Divided. by"
                sGreater = "greater than": sLess = "less than": sNotEqual = "not equal to"
                sGreaterOrEqual = "greater Or equal to": sLessOrEqual = "less or equal to"
            Case InStr(.Voice.GetDescription, "Spanish")
                sCell = "Celda": sFormula = "Formula": sValue = "Valor": sContains = "Contiene"
                sHyperLink = "Hiper Enlace": sFalse = "Falso": sTrue = "Verdadero": sAddress = "direccion"
                'some rudimentary arithmetic operators translations into Spanish ..(+/*-<>...)... might need to be extended.
                sMinus = "menos": sPlus = "mas": sTimes = "multiplicado por": sDividedBy = "dividido por"
                sGreater = "mayor que": sLess = "menor que": sNotEqual = "distinto de"
                sGreaterOrEqual = "mayor o igual que ": sLessOrEqual = "menor o igual que"
            Case InStr(.Voice.GetDescription, "French")
                sCell = "Cellule": sFormula = "Formule": sValue = "Valeur": sContains = "Contien"
                sHyperLink = "Lien HyperTexte": sFalse = "Faux": sTrue = "Vrai": sAddress = "adresse"
                'some rudimentary arithmetic operators translation into French ..(+/*-<>...)... might need to be extended.
                sMinus = "moins": sPlus = "plus": sTimes = "multiplié par": sDividedBy = "divisé par"
                sGreater = "superieur a": sLess = "inferieur a": sNotEqual = "different de"
                sGreaterOrEqual = "supérieur ou égal à": sLessOrEqual = "inférieur ou égal à"
        End Select
    End With

    If TypeName(ObjUnderMouse) = "Range" Then
        If Not IsEmpty(ObjUnderMouse) Then
            sTmpText = sCell & ObjUnderMouse.Address(False, False)
            If ObjUnderMouse.HasFormula Then
            sTmpText = sTmpText & ". " & sContains & sFormula & ". " & ObjUnderMouse.Formula
            sTmpText = Replace(sTmpText, "-", sMinus)
            sTmpText = Replace(sTmpText, "+", sPlus)
            sTmpText = Replace(sTmpText, "*", sTimes)
            sTmpText = Replace(sTmpText, "/", sDividedBy)
            sTmpText = Replace(sTmpText, "<>", sNotEqual)
            sTmpText = Replace(sTmpText, ">=", sGreaterOrEqual)
            sTmpText = Replace(sTmpText, "<=", sLessOrEqual)
            sTmpText = Replace(sTmpText, "<", sLess)
            sTmpText = Replace(sTmpText, ">", sGreater)
            End If
            If HasHyperLink(ObjUnderMouse) Then
                sTmpText = sTmpText & ". " & sHyperLink & ". " & sAddress & _
                ObjUnderMouse.Hyperlinks(1).SubAddress & ObjUnderMouse.Hyperlinks(1).Address
            End If
            If HasHyperLink(ObjUnderMouse) = False Then
                sTmpText = sTmpText & ". " & sValue & ". " & ObjUnderMouse.Value
                sTmpText = Replace(sTmpText, False, sFalse)
                sTmpText = Replace(sTmpText, True, sTrue)
            End If
        Else
            TextToSpeech vbNullString, 0, 0
        End If
    End If

    If TypeName(ObjUnderMouse) = "OLEObject" Then
        sTmpText = ObjUnderMouse.Name
        If ObjUnderMouse.Name <> ObjUnderMouse.Object.Caption Then
            sTmpText = sTmpText & ". " & ObjUnderMouse.Object.Caption
        End If
        If InStr(TypeName(ObjUnderMouse.Object), "CommandButton") = 0 And _
        InStr(TypeName(ObjUnderMouse.Object), "ToggleButton") = 0 Then
            sTmpText = sTmpText & ". " & ObjUnderMouse.Object.Value
            sTmpText = Replace(sTmpText, False, sFalse)
            sTmpText = Replace(sTmpText, True, sTrue)
        End If
    ElseIf TypeName(ObjUnderMouse) <> "Range" Then
        sTmpText = ObjUnderMouse.Name
        If ObjUnderMouse.Name <> ObjUnderMouse.Caption Then
            sTmpText = sTmpText & ".  " & ObjUnderMouse.Caption
        End If
        If TypeName(ObjUnderMouse) = "CheckBox" Or TypeName(ObjUnderMouse) = "OptionButton" Then
            If ObjUnderMouse = -4146 Then
                sTmpText = sTmpText & ". " & sFalse
            Else
                sTmpText = sTmpText & ". " & sTrue
            End If
        End If
    sTmpText = sTmpText & ". " & ObjUnderMouse.List(ObjUnderMouse.ListIndex)
    End If

    BuildStringDescriptionFromObjectWithinSheet = sTmpText

End Function
    
#If Win64 Then
    Private Function vtblCall(ByVal InterfacePointer As LongLong, ByVal VTableOffset As Long, ByVal FunctionReturnType As Long, ByVal CallConvention As Long, ParamArray FunctionParameters() As Variant) As Variant
        Dim vParamPtr() As LongLong
#Else
    Private Function vtblCall(ByVal InterfacePointer As Long, ByVal VTableOffset As Long, ByVal FunctionReturnType As Long, ByVal CallConvention As Long, ParamArray FunctionParameters() As Variant) As Variant
        Dim vParamPtr() As Long
#End If
    
    Dim pIndex As Long, pCount As Long
    Dim vParamType() As Integer
    Dim vRtn As Variant, vParams() As Variant

    vParams() = FunctionParameters()
    pCount = Abs(UBound(vParams) - LBound(vParams) + 1&)
    If pCount = 0& Then
        ReDim vParamPtr(0 To 0)
        ReDim vParamType(0 To 0)
    Else
        ReDim vParamPtr(0 To pCount - 1&)
        ReDim vParamType(0 To pCount - 1&)
        For pIndex = 0& To pCount - 1&
            vParamPtr(pIndex) = VarPtr(vParams(pIndex))
            vParamType(pIndex) = VarType(vParams(pIndex))
        Next
    End If

     pIndex = DispCallFunc(InterfacePointer, VTableOffset, CallConvention, FunctionReturnType, pCount, vParamType(0), vParamPtr(0), vRtn)

    If pIndex = 0& Then
        vtblCall = vRtn
    Else
        Call SetLastError(pIndex)
    End If
End Function

#If Win64 Then
    Private Function GetStrFromPtrW(ByVal Ptr As LongLong) As String
#Else
    Private Function GetStrFromPtrW(ByVal Ptr As Long) As String
#End If
    Call SysReAllocString(VarPtr(GetStrFromPtrW), Ptr)
End Function

Private Sub DispGUID(objGuid As GUID)
    Dim lRet As Long
    Dim sTmp As String
    Dim buf(100) As Byte
    
    lRet = StringFromGUID2(objGuid, VarPtr(buf(0)), UBound(buf) - 1)
    sTmp = buf
End Sub

Private Function HasHyperLink(ByVal oRng As Range) As Boolean
    HasHyperLink = CBool(oRng.Hyperlinks.Count)
End Function

Private Sub Auto_Close()
   Call Reset
End Sub



2- UserForm Module:
VBA Code: 
Option Explicit

Private Sub UserForm_Initialize()

    Dim oVoice As Object, i As Long
                    
    'Store XL window handle in the Desktop Window.
    AppHwnd = Application.hwnd
    
    'Populate ListBox with installed voices.
    Set oVoice = CreateObject("SAPI.SpVoice")
    With oVoice
        If .GetVoices.Count Then
            For i = 0 To .GetVoices.Count - 1
                Set .Voice = .GetVoices.Item(i)
                Me.ListBox1.AddItem .Voice.GetDescription
            Next i
            Me.ListBox1.Selected(0) = True
        Else
            Call SetProps("Voice", -1)
            MsgBox "No Voices Installed."
            Unload Me
        End If
    End With

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    On Error Resume Next
    
    'UserForm Cancelled.
    If GetProps("Voice") = -1 Or CloseMode = 0 Then
        Call SetProps("Voice", -1)
        Exit Sub
    End If
    
    'Don't show Voices Form again.
    If Me.CheckBox1.Value Then
        Call SetProps("DontShowAgain", -1)
    End If
    
    If Me.CheckBox2.Value Then
        Call SetProps("GlobalScope", -1)
    Else
        Call SetProps("GlobalScope", 0)
    End If

End Sub

Private Sub CommandButton1_Click()
    Call SetProps("Voice", CLng(ListBox1.ListIndex))
    Unload Me
End Sub

Private Sub CommandButton2_Click()
    Call SetProps("Voice", -1)
    Unload Me
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetProps("Voice", CLng(ListBox1.ListIndex))
    Unload Me
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

Jaafar Tribak
  • Question Question
Capturing the Paste Event (API Hooking - Redirection)
Replies
4
Views
858
Jaafar Tribak
Jaafar Tribak
Jaafar Tribak
  • Question Question
KeyPress Event for Worksheet Cells (Subclassing Without Crashing)
Replies
1
Views
378
Bib195
B
J
  • Solved
Get IAccessible of UserForm control without reference
2
Replies
12
Views
1K
Jaafar Tribak
Jaafar Tribak
D
  • Solved
DispCallFunc - 64bit VBA
Replies
6
Views
1K
Dan_W
D
Jaafar Tribak
  • Question Question
Blurring images using Direct2D & Windows Imaging Component
Replies
3
Views
822
Dan_W
D

Forum statistics

Threads
1,224,712
Messages
6,180,507
Members
452,986
Latest member
zenki1

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