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
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?
Nice. You need a second column for the caption of the accelerated control.
Peter,
There is an addin from Ivan F – Called List Shortcut keys – check out his website
Sam
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.
The download link on Ivan F’s website (http://www.xcelfiles.com/GetShortCutKeys.html) doesn’t seem to be working.
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
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