Show the "Edit Name" dialog from VBA for a specific Name

[ides315]

Hi! I was hoping someone might be able to tell me how to display the Edit Name dialog box from VBA for a specific existing name -- i.e. the dialog you would access manually via Formulas > Name Manager > [choose the name from the List Box] > Edit... .

The name in question is a LAMBDA function - let's call it MyFunction - which appears in various places throughout the workbook. I want to show the Edit Name dialog for MyFunction when my end user clicks a "Customize" button, to enable him/her to modify its functionality in an obvious way, without having to sift through all the other various names the workbook has in the Name Manager.

I've scoured this list of built-in Application.Dialogs, as well as this list of arguments you can pass to the Show method of a Dialog to see if maybe there was a way to do something like Application.Dialogs(xlNameManager).Show("MyFunction"), or Application.Dialogs(xlNameManager).Show(ThisWorkbook.Names("MyFunction"))... but to no avail.

I did come up with this sub as a workaround:

Sub EditMyFunction()
    Dim vFormula As Variant
    With ThisWorkbook.Names("MyFunction")
        vFormula = Application.InputBox("Enter LAMBDA Expression:", "Edit Function", Default:=.RefersTo, Type:=0)
        If vFormula = False Then Exit Sub
        .RefersTo = vFormula
    End With
End Sub

This works well enough... but IMHO it's just not as elegant as showing the builtin Edit Name dialog. The layout is less familiar; Application.InputBox has a "?" button in the Title bar which takes the user out to an irrelevant help page; and there is no space to leave/edit the Comment on MyFunction. While a UserForm could address some of these issues, I'd rather not create a whole mimic UserForm.

Any suggestions or solutions you can provide are welcome! Even if it's something hacky, or exceedingly complex, which uses a bunch of Windows APIs and such... I'm not afraid to get my hands dirty. I just kinda don't want to accept that answer seems to be "no; you can't do that"... I mean, isn't the joy of Excel that there is nothing you can't do if you really want to?

Thanks a bunch!

 

[Jaafar Tribak]

In case you are still interested, I did something similar in the past using win32 calls and win accessibility.

1- Add a new Standard Module to your project and place the following code in it:

Option Explicit

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


#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 AccessibleChildren Lib "Oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Private Declare PtrSafe 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 lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) 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 GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr
    Private Declare PtrSafe Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 AccessibleChildren Lib "Oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Private Declare 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 lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr
    Private Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As LongPtr) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#End If


Public Function ShowEditNameDialog(ByVal NameToEdit As String) As Boolean
    If NameExists(NameToEdit) Then
        Call SetTimer(Application.hwnd, StrPtr(NameToEdit), 0&, AddressOf TimerProc)
        Application.Dialogs(xlDialogNameManager).Show
        ShowEditNameDialog = True
    End If
End Function


Private Sub TimerProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal nIDEvent As LongPtr, ByVal dwTime As Long)

    Const SELFLAG_TAKESELECTION = &H2
    Dim vAccChildren As Variant
    Dim oAcc As IAccessible
    Dim sName As String, i As Long
    Dim hParent As LongPtr, hChild As LongPtr

    'Timer no longer needed so kill it now.
    Call KillTimer(Application.hwnd, nIDEvent)
 
    'Retrieve the Accessibility interface of the Names listview control.
    hParent = FindWindowEx(FindWindow("bosa_sdm_XL9", vbNullString), 0, "XLLVP", vbNullString)
    hChild = FindWindowEx(hParent, NULL_PTR, "SysListView32", vbNullString)
    Set oAcc = GetAccFromHnwd(hChild)
 
    'Recover the Name string from its pointer.
    sName = GetStringFromPointer(nIDEvent)
 
    'Look for the Name string in the listview and select it.
    Do
        i = i + 1
        Call AccessibleChildren(oAcc, 0&, 1&, vAccChildren, 0&)
        If LCase(oAcc.accName(i)) = LCase(sName) Then
            oAcc.accSelect SELFLAG_TAKESELECTION, i
            Exit Do
        End If
    Loop Until i >= oAcc.accChildCount
 
    'Retrieve the Accessibility interface of the main Names dialog and click the Edit button.
    Set oAcc = GetAccFromHnwd(FindWindow("bosa_sdm_XL9", vbNullString))
    DoEvents
    Call oAcc.accDoDefaultAction(2&)
 
    'Highlight the 'RefersTo' field.
    Call SetTimer(Application.hwnd, NULL_PTR, 100&, AddressOf Highlight)

End Sub

Private Sub Highlight()
    Call KillTimer(Application.hwnd, NULL_PTR)
    Call SetFocusAPI(GetDlgItem(GetActiveWindow, &H17))
End Sub

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

Private Function GetStringFromPointer(ByVal lpString As LongPtr) As String
   Dim lLength As Long, sBuffer As String
   lLength = lstrlen(lpString)
   sBuffer = Space$(lLength)
   Call CopyMemory(ByVal StrPtr(sBuffer), ByVal lpString, lLength * 2)
   GetStringFromPointer = sBuffer
End Function

Private Function NameExists(ByVal sName As String) As Boolean
    Dim oName As Name
    On Error Resume Next
        Set oName = Names(sName)
    On Error GoTo 0
    NameExists = Not (oName Is Nothing)
End Function

2- Usage Example:
Then, use the above ShowEditNameDialog custom function to bring up the Edit Name dialogbox ready for user input as follows:

Sub Test()

    'Assumes 'MyFunction' is an existing valid Name ... Change Name as needed.
    If ShowEditNameDialog(NameToEdit:="MyFunction") Then
        Debug.Print "success."
    Else
        MsgBox "No such name exists!"
    End If

End Sub