List Userform Hotkeys

I hate trying to figure out which hotkeys are available when I need to add a control to a userform, so I wrote a procedure to list them.

Sub ListHotKeys(uf As UserForm)
   
    Dim ctl As Control
    Dim aKeys() As String
    Dim sKey As String
    Dim i As Long, j As Long
   
    For Each ctl In uf.Controls
        sKey = “”
       
        ‘Not all controls have this property
       On Error Resume Next
            sKey = ctl.Accelerator
        On Error GoTo 0
       
        If Len(sKey) > 0 Then
            i = i + 1
            ReDim Preserve aKeys(1 To i)
            aKeys(i) = sKey
        End If
    Next ctl
   
    For i = LBound(aKeys) To UBound(aKeys) – 1
        For j = i + 1 To UBound(aKeys)
            If aKeys(i) > aKeys(j) Then
                sKey = aKeys(i)
                aKeys(i) = aKeys(j)
                aKeys(j) = sKey
               
            End If
        Next j
    Next i
   
    For i = 1 To UBound(aKeys)
        Debug.Print aKeys(i)
    Next i
       
End Sub

Posted in Uncategorized

7 thoughts on “List Userform Hotkeys

  1. Hi. I have often wondered if similar code can be written to detect what keyboard shortcuts are in use by currently open macros. Any thoughts?

  2. Peter,

    There is an addin from Ivan F – Called List Shortcut keys – check out his website

    Sam

  3. Peter
    Shortcut keys are a hidden property of a procedure. You can see them if you export the module and then open it in a text editor. Ivan may have (/will have) a more refined way.

  4. Found on some Japanese VBA forum and a little bit re-written:

    Sub GetShortCutKeys()

    Dim DefPath As String
    Dim FNo As Integer
    Dim LineBuf As String
    Dim i As Integer
    Dim buf() As String
    Dim bufName As String
    Dim bufKeyName As String
    Dim vbc As Object
    Const AT1 As String = “Attribute “
    Const AT2 As String = “VB_Invoke_Func =”
    Const TMPF As String = “Temp1.bas”

    DefPath = ThisWorkbook.Path & “”
     With ThisWorkbook.VBProject
     For Each vbc In .VBComponents
     .VBComponents(vbc.Name).Export Filename:=DefPath & TMPF
     FNo = FreeFile()
     Open DefPath & TMPF For Input As #FNo
     While Not EOF(FNo)
      Line Input #FNo, LineBuf
      If InStr(1, LineBuf, “Sub”, vbTextCompare) = 1 Then
       bufName = Mid$(LineBuf, InStr(LineBuf, “Sub”) + 4)
      End If
      If InStr(LineBuf, AT1) = 1 And InStr(LineBuf, AT2) > 0 Then
       ReDim Preserve buf(i)
       bufKeyName = ” : Ctrl + “ & Mid$(LineBuf, InStrRev(LineBuf, “=”) + 3, 1)
       buf(i) = bufName & bufKeyName
       
       Debug.Print bufName; bufKeyName
       i = i + 1
       bufName = “”
      End If
      LineBuf = “”
     Wend
     Close #FNo
     Kill DefPath & TMPF
     Next
     End With
     MsgBox Join(buf, vbCrLf)
     
    End Sub

  5. Sub ListHotKeys(uf As UserForm)
       
        Dim ctl As Control
        Dim aKeys() As String
        Dim sKey As String, sCap As String
        Dim i As Long, j As Long
       
        For Each ctl In uf.Controls
            sKey = “”
           
            ‘Not all controls have this property
           On Error Resume Next
                sKey = ctl.Accelerator
            On Error GoTo 0
           
            If Len(sKey) > 0 Then
                i = i + 1
                ReDim Preserve aKeys(1 To 2, 1 To i)
                aKeys(1, i) = sKey
                aKeys(2, i) = ctl.Caption
            End If
        Next ctl
       
        For i = LBound(aKeys, 2) To UBound(aKeys, 2) – 1
            For j = i + 1 To UBound(aKeys, 2)
                If UCase(aKeys(1, i)) > UCase(aKeys(1, j)) Then
                    sKey = aKeys(1, i)
                    sCap = aKeys(2, i)
                    aKeys(1, i) = aKeys(1, j)
                    aKeys(2, i) = aKeys(2, j)
                    aKeys(1, j) = sKey
                    aKeys(2, j) = sCap
                End If
            Next j
        Next i
       
        For i = 1 To UBound(aKeys, 2)
            Debug.Print aKeys(1, i), aKeys(2, i)
        Next i
           
    End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *