Programmatically get list of all functions from Function Wizard dialog

vincehardwick

New Member
Joined
Feb 4, 2021
Messages
20
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I'm trying to work out a way to programmatically obtain a list of all the function names that appear in the Excel function wizard's 'Select a function' combobox when you select the 'All' category:

1628507888936.png


I need this so that instead of having to manually create and maintain a list of their names on a sheet (which is my only backup plan atm, it would just be onerous and prone to human error), it can be automatically kept up-to-date if/when Microsoft add new functions in later versions. This is in relation to a function I'm putting together to offset cell/range references in formulas, I need to be able to strip out all function names from a formula as one of the steps in reducing a formula to only its cell/range references.

I've found that you can launch the Function Wizard dialog from VBA - via either Range.FunctionWizard or Application.Dialogs(xlDialogFunctionWizard).Show - but the list of functions doesn't appear to be exposed via that method. I've also scoured through all the CommandBar objects and their Controls, and although I can find the Insert...Function button or the formula auditing items, again the list of all function names didn't show up.

Any ideas?

Vince
 
Ok- The following worked for me quite nicely using accessibility :

Demo Workbook: GetAllExcelFunctions.xls


1- In a Standard Module:
VBA Code:
Option Explicit

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

#If VBA7 Then
    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 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 CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal pModuleName As LongPtr) 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 hHook As LongPtr
#Else
    Private Declare Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As Long, ByVal dwId As Long, ByVal riid As Long, ppvObject As Any) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByVal lpiid As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal pModuleName As Long) 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 hHook As Long
#End If
   
Private sFuncsArray() As String      
   

Public Function GetAllExcelFunctions() As String()

    Const WH_CBT = 5

    If hHook Then Exit Function
    hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, GetModuleHandle(StrPtr(vbNullString)), GetCurrentThreadId)
    Application.Dialogs(xlDialogFunctionWizard).Show
    GetAllExcelFunctions = sFuncsArray
    ReDim sFuncsArray(UBound(sFuncsArray))
    Call UnhookWindowsHookEx(hHook): hHook = 0

End Function  
   
#If Win64 Then
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
#Else
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Const HC_ACTION = 0
    Const HCBT_ACTIVATE = 5
   
    If lCode < HC_ACTION Then
        HookProc = CallNextHookEx(hHook, lCode, wParam, lParam)
        Exit Function
    End If
   
    If lCode = HCBT_ACTIVATE Then
        If IsDlg(wParam) Then
            Call UnhookWindowsHookEx(hHook): hHook = 0
            Call GetTheFunctions(wParam)
        End If
    End If

    Call CallNextHookEx(hHook, lCode, wParam, lParam)
 
End Function

#If Win64 Then
    Private Sub GetTheFunctions(ByVal hwnd As LongLong)
#Else
    Private Sub GetTheFunctions(ByVal hwnd As Long)
#End If

    Const ID_ACCESSIBLE As String = "{618736E0-3C3D-11CF-810C-00AA00389B71}"
    Const ROLE_SYSTEM_COMBOBOX = &H2E
    Const ROLE_SYSTEM_LIST = &H21
    Const OBJID_CLIENT = &HFFFFFFFC
    Const S_OK = &H0&
   
    Dim tGUID(0 To 3) As Long, oAccClient  As IAccessible, oAccChild As IAccessible
    Dim i As Long, k As Long
   
    On Error Resume Next
   
    If IIDFromString(StrPtr(ID_ACCESSIBLE), VarPtr(tGUID(0))) = S_OK Then
        If AccessibleObjectFromWindow(hwnd, OBJID_CLIENT, VarPtr(tGUID(0)), oAccClient) = S_OK Then
            Do
                If oAccClient.accRole(i) = ROLE_SYSTEM_COMBOBOX Then
                    oAccClient.accChild(i).accDoDefaultAction (2&)
                End If
                If oAccClient.accRole(i) = ROLE_SYSTEM_LIST Then
                    ReDim sFuncsArray(oAccClient.accChild(i).accChildCount + 1)
                    For k = 1 To oAccClient.accChild(i).accChildCount
                        Set oAccChild = oAccClient.accChild(i)
                        sFuncsArray(k) = oAccChild.accName(k)
                    Next
                End If
                i = i + 1
                DoEvents
            Loop Until i >= oAccClient.accChildCount
            oAccClient.accDoDefaultAction (13&)
        End If
    End If

End Sub

#If Win64 Then
    Private Function IsDlg(ByVal hwnd As LongLong) As Boolean
#Else
    Private Function IsDlg(ByVal hwnd As Long) As Boolean
#End If

    Const MAX_PATH = 260
    Dim sClassName As String * MAX_PATH, lRet As Long
 
    lRet = GetClassName(hwnd, sClassName, MAX_PATH)
    If Left$(sClassName, lRet) = "bosa_sdm_XL9" Then IsDlg = True

End Function


2- Code Usage example:
VBA Code:
Option Explicit

Sub Test()

    Dim sExcelFunctions() As String
   
    sExcelFunctions = GetAllExcelFunctions
   
    If Len(Join(sExcelFunctions, "")) Then
        With Range("a1")
            .EntireColumn.Clear
            .Font.Bold = True
            Range("a1") = "Total Excel Functions Found: (" & UBound(sExcelFunctions) - 1 & ")"
            .Offset(1).Resize(UBound(sExcelFunctions)) = Application.Transpose(sExcelFunctions)
            .EntireColumn.AutoFit
        End With
    Else
        MsgBox "Unable to get the Excel functions", , "ERROR !"
    End If

End Sub
 
Upvote 0

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Ok- The following worked for me quite nicely using accessibility :

Demo Workbook: GetAllExcelFunctions.xls


1- In a Standard Module:
VBA Code:
Option Explicit

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

#If VBA7 Then
    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 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 CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal pModuleName As LongPtr) 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 hHook As LongPtr
#Else
    Private Declare Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As Long, ByVal dwId As Long, ByVal riid As Long, ppvObject As Any) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByVal lpiid As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal pModuleName As Long) 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 hHook As Long
#End If
  
Private sFuncsArray() As String     
  

Public Function GetAllExcelFunctions() As String()

    Const WH_CBT = 5

    If hHook Then Exit Function
    hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, GetModuleHandle(StrPtr(vbNullString)), GetCurrentThreadId)
    Application.Dialogs(xlDialogFunctionWizard).Show
    GetAllExcelFunctions = sFuncsArray
    ReDim sFuncsArray(UBound(sFuncsArray))
    Call UnhookWindowsHookEx(hHook): hHook = 0

End Function 
  
#If Win64 Then
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
#Else
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Const HC_ACTION = 0
    Const HCBT_ACTIVATE = 5
  
    If lCode < HC_ACTION Then
        HookProc = CallNextHookEx(hHook, lCode, wParam, lParam)
        Exit Function
    End If
  
    If lCode = HCBT_ACTIVATE Then
        If IsDlg(wParam) Then
            Call UnhookWindowsHookEx(hHook): hHook = 0
            Call GetTheFunctions(wParam)
        End If
    End If

    Call CallNextHookEx(hHook, lCode, wParam, lParam)
 
End Function

#If Win64 Then
    Private Sub GetTheFunctions(ByVal hwnd As LongLong)
#Else
    Private Sub GetTheFunctions(ByVal hwnd As Long)
#End If

    Const ID_ACCESSIBLE As String = "{618736E0-3C3D-11CF-810C-00AA00389B71}"
    Const ROLE_SYSTEM_COMBOBOX = &H2E
    Const ROLE_SYSTEM_LIST = &H21
    Const OBJID_CLIENT = &HFFFFFFFC
    Const S_OK = &H0&
  
    Dim tGUID(0 To 3) As Long, oAccClient  As IAccessible, oAccChild As IAccessible
    Dim i As Long, k As Long
  
    On Error Resume Next
  
    If IIDFromString(StrPtr(ID_ACCESSIBLE), VarPtr(tGUID(0))) = S_OK Then
        If AccessibleObjectFromWindow(hwnd, OBJID_CLIENT, VarPtr(tGUID(0)), oAccClient) = S_OK Then
            Do
                If oAccClient.accRole(i) = ROLE_SYSTEM_COMBOBOX Then
                    oAccClient.accChild(i).accDoDefaultAction (2&)
                End If
                If oAccClient.accRole(i) = ROLE_SYSTEM_LIST Then
                    ReDim sFuncsArray(oAccClient.accChild(i).accChildCount + 1)
                    For k = 1 To oAccClient.accChild(i).accChildCount
                        Set oAccChild = oAccClient.accChild(i)
                        sFuncsArray(k) = oAccChild.accName(k)
                    Next
                End If
                i = i + 1
                DoEvents
            Loop Until i >= oAccClient.accChildCount
            oAccClient.accDoDefaultAction (13&)
        End If
    End If

End Sub

#If Win64 Then
    Private Function IsDlg(ByVal hwnd As LongLong) As Boolean
#Else
    Private Function IsDlg(ByVal hwnd As Long) As Boolean
#End If

    Const MAX_PATH = 260
    Dim sClassName As String * MAX_PATH, lRet As Long
 
    lRet = GetClassName(hwnd, sClassName, MAX_PATH)
    If Left$(sClassName, lRet) = "bosa_sdm_XL9" Then IsDlg = True

End Function


2- Code Usage example:
VBA Code:
Option Explicit

Sub Test()

    Dim sExcelFunctions() As String
  
    sExcelFunctions = GetAllExcelFunctions
  
    If Len(Join(sExcelFunctions, "")) Then
        With Range("a1")
            .EntireColumn.Clear
            .Font.Bold = True
            Range("a1") = "Total Excel Functions Found: (" & UBound(sExcelFunctions) - 1 & ")"
            .Offset(1).Resize(UBound(sExcelFunctions)) = Application.Transpose(sExcelFunctions)
            .EntireColumn.AutoFit
        End With
    Else
        MsgBox "Unable to get the Excel functions", , "ERROR !"
    End If

End Sub
Jaafar - this is some seriously impressive work, I can't thank you enough. I've given it a whirl and it's spot on, I'll adapt your excellent code to filter out any functions in VBA projects declared as public, and this should do the trick very nicely.

Thanks again,
Vince
 
Upvote 0
Jaafar - this is some seriously impressive work, I can't thank you enough. I've given it a whirl and it's spot on,
Thanks for the feedback and glad you found the code useful.

I'll adapt your excellent code to filter out any functions in VBA projects declared as public, and this should do the trick very nicely.
Yes... Never occurred to me to filter out any Non-Private functions that might exist in the vba projects. This can cause unnecessary confusion.
I will post the new updated code later on when I get home.
 
Upvote 0
Here is the new code which takes into account whether the user wants to filter out the vbprojects functions and UDFs or not.

The GetAllExcelFunctions now takes an optional Boolean argument (ExcludeVBProjectFunctions)... Setting this argument to TRUE filters out all the functions that might exist in the vbprojects as well as all UDTs, leaving the user with just the native excel functions.

Demo: GetAllExcelFunctions_With_UDFs_Filter.xls


1- Code in a Standard Module:
VBA Code:
Option Explicit

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

#If VBA7 Then
     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 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 CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
     Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
     Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
     Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal pModuleName As LongPtr) 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 hHook As LongPtr
#Else
    Private Declare Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As Long, ByVal dwId As Long, ByVal riid As Long, ppvObject As Any) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByVal lpiid As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal pModuleName As Long) 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 hHook As Long
#End If

    
Private sFuncsArray() As String
Private bFilterOut As Boolean


Public Function GetAllExcelFunctions(Optional ByVal ExcludeVBProjectFunctions As Boolean) As String()

    Const WH_CBT = 5

    If hHook Then Exit Function
    Application.EnableCancelKey = xlDisabled
    bFilterOut = ExcludeVBProjectFunctions
    hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, GetModuleHandle(StrPtr(vbNullString)), GetCurrentThreadId)
    Application.Dialogs(xlDialogFunctionWizard).Show
    GetAllExcelFunctions = sFuncsArray
    ReDim sFuncsArray(UBound(sFuncsArray))
    Call UnhookWindowsHookEx(hHook): hHook = 0

End Function
    
    
'_______________________________________PRIVATE ROUTINES______________________________________________
#If Win64 Then
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
#Else
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Const HC_ACTION = 0
    Const HCBT_ACTIVATE = 5
    
    If lCode < HC_ACTION Then
        HookProc = CallNextHookEx(hHook, lCode, wParam, lParam)
        Exit Function
    End If
    
    If lCode = HCBT_ACTIVATE Then
        If IsDlg(wParam) Then
            Call UnhookWindowsHookEx(hHook): hHook = 0
            Call GetTheFunctions(wParam)
        End If
    End If

    Call CallNextHookEx(hHook, lCode, wParam, lParam)
 
End Function


#If Win64 Then
    Private Sub GetTheFunctions(ByVal hwnd As LongLong)
#Else
    Private Sub GetTheFunctions(ByVal hwnd As Long)
#End If

    Const ID_ACCESSIBLE As String = "{618736E0-3C3D-11CF-810C-00AA00389B71}"
    Const ROLE_SYSTEM_COMBOBOX = &H2E
    Const ROLE_SYSTEM_LIST = &H21
    Const OBJID_CLIENT = &HFFFFFFFC
    Const S_OK = &H0&
    
    Dim tGUID(0 To 3) As Long
    Dim sUserDefinedArray() As String
    Dim oAccClient  As IAccessible, oAccChild As IAccessible
    Dim oAccUserDefined As IAccessible, oAccUserDefinedList As IAccessible
    Dim lClientChildIndex1 As Long, lClientChildIndex2 As Long
    Dim lUserDefinedListIndex As Long, lClientChildCount As Long, lFuncIndex As Long
    Dim i As Long, j As Long    
          
    On Error Resume Next
    
    If IIDFromString(StrPtr(ID_ACCESSIBLE), VarPtr(tGUID(0))) = S_OK Then
        If AccessibleObjectFromWindow(hwnd, OBJID_CLIENT, VarPtr(tGUID(0)), oAccClient) = S_OK Then
            If bFilterOut Then
                Do
                    If oAccClient.accRole(i) = ROLE_SYSTEM_COMBOBOX Then
                    lClientChildCount = oAccClient.accChildCount
                        For lClientChildIndex1 = 0 To lClientChildCount
                            Set oAccUserDefined = oAccClient.accChild(i)
                            If oAccUserDefined.accName(lClientChildIndex1) = "User Defined" Then
                                oAccUserDefined.accDoDefaultAction (lClientChildIndex1)
                                For lClientChildIndex2 = 0 To lClientChildCount
                                    If oAccClient.accRole(lClientChildIndex2) = ROLE_SYSTEM_LIST Then
                                        Set oAccUserDefinedList = oAccClient.accChild(lClientChildIndex2)
                                        For lUserDefinedListIndex = 0 To oAccUserDefinedList.accChildCount
                                            ReDim Preserve sUserDefinedArray(lUserDefinedListIndex)
                                            sUserDefinedArray(lUserDefinedListIndex) = oAccUserDefinedList.accName(lUserDefinedListIndex)
                                        Next lUserDefinedListIndex
                                    End If
                                Next lClientChildIndex2
                            End If
                        Next lClientChildIndex1
                    End If
                    i = i + 1
                    lClientChildCount = oAccClient.accChildCount
                    DoEvents
                Loop Until i >= lClientChildCount
            End If
            
            i = 0
            Do
                If oAccClient.accRole(i) = ROLE_SYSTEM_COMBOBOX Then
                    oAccClient.accChild(i).accDoDefaultAction (2&)
                End If
                If oAccClient.accRole(i) = ROLE_SYSTEM_LIST Then
                    For j = 1 To oAccClient.accChild(i).accChildCount
                        Set oAccChild = oAccClient.accChild(i)
                        If IsValueInArray(oAccChild.accName(j), sUserDefinedArray) = False Then
                            ReDim Preserve sFuncsArray(lFuncIndex + 1)
                            sFuncsArray(lFuncIndex) = oAccChild.accName(j)
                            lFuncIndex = lFuncIndex + 1
                        End If
                    Next j
                End If
                i = i + 1
                DoEvents
            Loop Until i >= oAccClient.accChildCount
            oAccClient.accDoDefaultAction (13&)
        End If
    End If

End Sub

#If Win64 Then
    Private Function IsDlg(ByVal hwnd As LongLong) As Boolean
#Else
    Private Function IsDlg(ByVal hwnd As Long) As Boolean
#End If
    Const MAX_PATH = 260
    Dim sClassName As String * MAX_PATH, lRet As Long
 
    lRet = GetClassName(hwnd, sClassName, MAX_PATH)
    If Left$(sClassName, lRet) = "bosa_sdm_XL9" Then IsDlg = True
End Function

Private Function IsValueInArray(vValue As Variant, Arr As Variant) As Boolean
    On Error Resume Next
    If IsArray(Arr) Then
        IsValueInArray = InStr(1, vbNullChar & Join(Arr, vbNullChar) & vbNullChar, vbNullChar & vValue & vbNullChar)
    End If
End Function



2- Code Usage example as per the workbook demo.
VBA Code:
Option Explicit

Sub Test()
    Dim sExcelFunctions() As String
    Dim bFilterArgument As Boolean
    
    If Application.Caller = "Button 1" Then
        bFilterArgument = True
    End If
    
    sExcelFunctions = GetAllExcelFunctions(ExcludeVBProjectFunctions:=bFilterArgument)
    
    If Len(Join(sExcelFunctions, "")) Then
        With Sheet1.Range("a1")
            .EntireColumn.Clear
            .Font.Size = 14
            .Font.Bold = True
            .Font.Underline = True
            .Font.Color = vbRed
            .EntireColumn.NumberFormat = "@"
            Sheet1.Range("a1") = "Total Excel Functions Found: (" & UBound(sExcelFunctions) & ")"
            .Offset(1).Resize(UBound(sExcelFunctions)) = Application.Transpose(sExcelFunctions)
            .EntireColumn.AutoFit
        End With
    Else
        MsgBox "Unable to get the Excel functions", , "Error !"
    End If
End Sub

Note: Given the fact that the above code uses MSAA, it is language sensitive which means that the code would need some tweaking if used on editions of excel other than English editions.
 
Upvote 0
Solution
Here is the new code which takes into account whether the user wants to filter out the vbprojects functions and UDFs or not.

The GetAllExcelFunctions now takes an optional Boolean argument (ExcludeVBProjectFunctions)... Setting this argument to TRUE filters out all the functions that might exist in the vbprojects as well as all UDTs, leaving the user with just the native excel functions.

Demo: GetAllExcelFunctions_With_UDFs_Filter.xls


1- Code in a Standard Module:
VBA Code:
Option Explicit

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

#If VBA7 Then
     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 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 CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
     Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
     Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
     Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal pModuleName As LongPtr) 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 hHook As LongPtr
#Else
    Private Declare Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As Long, ByVal dwId As Long, ByVal riid As Long, ppvObject As Any) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByVal lpiid As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal pModuleName As Long) 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 hHook As Long
#End If

   
Private sFuncsArray() As String
Private bFilterOut As Boolean


Public Function GetAllExcelFunctions(Optional ByVal ExcludeVBProjectFunctions As Boolean) As String()

    Const WH_CBT = 5

    If hHook Then Exit Function
    Application.EnableCancelKey = xlDisabled
    bFilterOut = ExcludeVBProjectFunctions
    hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, GetModuleHandle(StrPtr(vbNullString)), GetCurrentThreadId)
    Application.Dialogs(xlDialogFunctionWizard).Show
    GetAllExcelFunctions = sFuncsArray
    ReDim sFuncsArray(UBound(sFuncsArray))
    Call UnhookWindowsHookEx(hHook): hHook = 0

End Function
   
   
'_______________________________________PRIVATE ROUTINES______________________________________________
#If Win64 Then
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
#Else
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Const HC_ACTION = 0
    Const HCBT_ACTIVATE = 5
   
    If lCode < HC_ACTION Then
        HookProc = CallNextHookEx(hHook, lCode, wParam, lParam)
        Exit Function
    End If
   
    If lCode = HCBT_ACTIVATE Then
        If IsDlg(wParam) Then
            Call UnhookWindowsHookEx(hHook): hHook = 0
            Call GetTheFunctions(wParam)
        End If
    End If

    Call CallNextHookEx(hHook, lCode, wParam, lParam)
 
End Function


#If Win64 Then
    Private Sub GetTheFunctions(ByVal hwnd As LongLong)
#Else
    Private Sub GetTheFunctions(ByVal hwnd As Long)
#End If

    Const ID_ACCESSIBLE As String = "{618736E0-3C3D-11CF-810C-00AA00389B71}"
    Const ROLE_SYSTEM_COMBOBOX = &H2E
    Const ROLE_SYSTEM_LIST = &H21
    Const OBJID_CLIENT = &HFFFFFFFC
    Const S_OK = &H0&
   
    Dim tGUID(0 To 3) As Long
    Dim sUserDefinedArray() As String
    Dim oAccClient  As IAccessible, oAccChild As IAccessible
    Dim oAccUserDefined As IAccessible, oAccUserDefinedList As IAccessible
    Dim lClientChildIndex1 As Long, lClientChildIndex2 As Long
    Dim lUserDefinedListIndex As Long, lClientChildCount As Long, lFuncIndex As Long
    Dim i As Long, j As Long   
         
    On Error Resume Next
   
    If IIDFromString(StrPtr(ID_ACCESSIBLE), VarPtr(tGUID(0))) = S_OK Then
        If AccessibleObjectFromWindow(hwnd, OBJID_CLIENT, VarPtr(tGUID(0)), oAccClient) = S_OK Then
            If bFilterOut Then
                Do
                    If oAccClient.accRole(i) = ROLE_SYSTEM_COMBOBOX Then
                    lClientChildCount = oAccClient.accChildCount
                        For lClientChildIndex1 = 0 To lClientChildCount
                            Set oAccUserDefined = oAccClient.accChild(i)
                            If oAccUserDefined.accName(lClientChildIndex1) = "User Defined" Then
                                oAccUserDefined.accDoDefaultAction (lClientChildIndex1)
                                For lClientChildIndex2 = 0 To lClientChildCount
                                    If oAccClient.accRole(lClientChildIndex2) = ROLE_SYSTEM_LIST Then
                                        Set oAccUserDefinedList = oAccClient.accChild(lClientChildIndex2)
                                        For lUserDefinedListIndex = 0 To oAccUserDefinedList.accChildCount
                                            ReDim Preserve sUserDefinedArray(lUserDefinedListIndex)
                                            sUserDefinedArray(lUserDefinedListIndex) = oAccUserDefinedList.accName(lUserDefinedListIndex)
                                        Next lUserDefinedListIndex
                                    End If
                                Next lClientChildIndex2
                            End If
                        Next lClientChildIndex1
                    End If
                    i = i + 1
                    lClientChildCount = oAccClient.accChildCount
                    DoEvents
                Loop Until i >= lClientChildCount
            End If
           
            i = 0
            Do
                If oAccClient.accRole(i) = ROLE_SYSTEM_COMBOBOX Then
                    oAccClient.accChild(i).accDoDefaultAction (2&)
                End If
                If oAccClient.accRole(i) = ROLE_SYSTEM_LIST Then
                    For j = 1 To oAccClient.accChild(i).accChildCount
                        Set oAccChild = oAccClient.accChild(i)
                        If IsValueInArray(oAccChild.accName(j), sUserDefinedArray) = False Then
                            ReDim Preserve sFuncsArray(lFuncIndex + 1)
                            sFuncsArray(lFuncIndex) = oAccChild.accName(j)
                            lFuncIndex = lFuncIndex + 1
                        End If
                    Next j
                End If
                i = i + 1
                DoEvents
            Loop Until i >= oAccClient.accChildCount
            oAccClient.accDoDefaultAction (13&)
        End If
    End If

End Sub

#If Win64 Then
    Private Function IsDlg(ByVal hwnd As LongLong) As Boolean
#Else
    Private Function IsDlg(ByVal hwnd As Long) As Boolean
#End If
    Const MAX_PATH = 260
    Dim sClassName As String * MAX_PATH, lRet As Long
 
    lRet = GetClassName(hwnd, sClassName, MAX_PATH)
    If Left$(sClassName, lRet) = "bosa_sdm_XL9" Then IsDlg = True
End Function

Private Function IsValueInArray(vValue As Variant, Arr As Variant) As Boolean
    On Error Resume Next
    If IsArray(Arr) Then
        IsValueInArray = InStr(1, vbNullChar & Join(Arr, vbNullChar) & vbNullChar, vbNullChar & vValue & vbNullChar)
    End If
End Function



2- Code Usage example as per the workbook demo.
VBA Code:
Option Explicit

Sub Test()
    Dim sExcelFunctions() As String
    Dim bFilterArgument As Boolean
   
    If Application.Caller = "Button 1" Then
        bFilterArgument = True
    End If
   
    sExcelFunctions = GetAllExcelFunctions(ExcludeVBProjectFunctions:=bFilterArgument)
   
    If Len(Join(sExcelFunctions, "")) Then
        With Sheet1.Range("a1")
            .EntireColumn.Clear
            .Font.Size = 14
            .Font.Bold = True
            .Font.Underline = True
            .Font.Color = vbRed
            .EntireColumn.NumberFormat = "@"
            Sheet1.Range("a1") = "Total Excel Functions Found: (" & UBound(sExcelFunctions) & ")"
            .Offset(1).Resize(UBound(sExcelFunctions)) = Application.Transpose(sExcelFunctions)
            .EntireColumn.AutoFit
        End With
    Else
        MsgBox "Unable to get the Excel functions", , "Error !"
    End If
End Sub

Note: Given the fact that the above code uses MSAA, it is language sensitive which means that the code would need some tweaking if used on editions of excel other than English editions.
This is superb work Jaafar, and is exactly what I needed. Thank you very much for putting in the time and effort to help me (and no doubt others) with this, it's greatly appreciated.

Vince
 
Upvote 0
This is superb work Jaafar, and is exactly what I needed. Thank you very much for putting in the time and effort to help me (and no doubt others) with this, it's greatly appreciated.

Vince

Thanks for the feedback vincehardwick

Actually, in the absence of any other cleaner alternative, this brute-force hack seems to be the only way of retrieving Excel functions and, to my surprise, it worked much better than I had initially thought (y)
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

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