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
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

Peter Carr:
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?
22 July 2008, 7:13 pmJon Peltier:
Nice. You need a second column for the caption of the accelerated control.
23 July 2008, 6:23 amsam:
Peter,
There is an addin from Ivan F - Called List Shortcut keys - check out his website
Sam
23 July 2008, 8:29 amSimon Murphy:
Peter
23 July 2008, 11:12 amShortcut 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.
Ken:
The download link on Ivan F's website (http://www.xcelfiles.com/GetShortCutKeys.html) doesn't seem to be working.
24 July 2008, 8:55 amyRadunchev:
Found on some Japanese VBA forum and a little bit re-written:
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