This worked for me on Xl97 and Xl2000 .... sory don't have Xl95

Option Explicit

Const strAttrShC As String = "VB_ProcData.VB_Invoke_Func = "
Const strAttrSub As String = "Attribute "
Const strFoobar As String = "ZZZZzzzz"

Dim strShortCuts() As String
Dim j As Integer

Sub mGetShortCutKeys()
'// By Ivan F Moala
'// http://www.XcelFiles.com
'// Testing done Xl97 & 2000
'// Needs a Reference to MS Visual Basics for Applications
Extensibilty lib
Dim strTempModFile As String
Dim NoComponents As Long
Dim i As Integer
Dim VBP As Object

Set VBP = ActiveWorkbook.VBProject
NoComponents = VBP.VBComponents.Count

'// Set a Temp path
strTempModFile = ActiveWorkbook.Path & Application.PathSeparator &
"Tmp.Txt"
'// inialize count
j = 0

On Error Resume Next
For i = 1 To NoComponents
'// We only want Modules
If VBP.VBComponents(i).Type = 1 Then
With VBP.VBComponents(i)
'// Export The ActiveWorkbooks CodeModule
.Export strTempModFile
ReadAttribute strTempModFile
End With
End If
Next

'// Now display it to a Sheet
With ActiveWorkbook
.Sheets.Add
.ActiveSheet.[A1].Resize(UBound(strShortCuts()) + 1, 1) = _
Application.WorksheetFunction.Transpose(strShortCu ts())
.ActiveSheet.Columns("A").Columns.AutoFit
.ActiveSheet.Columns("A").Columns.HorizontalAlignm ent = xlLeft
End With

Erase strShortCuts()

End Sub

Function ReadAttribute(strBas As String) As String
Dim strTxt As String
Dim handle As Long
Dim Pos As Long
Dim NewPos As Long
Dim PosSub As String
Dim x As Integer
Dim ShortCutKey As String
Dim SubName As String
Dim blnShift As Boolean

'// Open bas file in binary mode
handle = FreeFile
Open strBas For Binary As #handle
'// Parse enougth spaces for text
strTxt = Space(LOF(handle))
'// Read the string IN and Close the file
Get #handle, , strTxt
Close #handle

'// Lets get the ShortCut Key!
Pos = 0: NewPos = 0: x = 0
Do
Pos = InStr(NewPos + 1, strTxt, strAttrShC)
ShortCutKey = Mid(strTxt, Pos + Len(strAttrShC) + 1, 1)
'// Is it a shortCut
If ShortCutKey = " " Then GoTo Skip
If Pos Then
'// Build SC Key
blnShift = (Asc(ShortCutKey) < 97)
ShortCutKey = IIf(blnShift, "Ctrl + shift + " &
ShortCutKey, "Ctrl + " & ShortCutKey)
x = Pos
Do Until PosSub = " "
PosSub = Mid(strTxt, x - 1, 1)
x = x - 1
Loop
SubName = Mid(strTxt, x, Pos - x - 1)
ReDim Preserve strShortCuts(j)
strShortCuts(j) = "Sub Routine Name:= " & SubName & _
" [ ShortCut:= " & ShortCutKey & " ]"
j = j + 1
PosSub = strFoobar
End If
Skip:
NewPos = Pos
Loop Until Pos = 0

'// Cleanup - Delete it
Kill strBas

End Function




windsurferLA wrote in message ...
In Excel95 or Excel97 is there a way to obtain a list of all the
keyboard shortcuts that have been assigned to custom macros?

I have an Excel based application that has over a 100 macros, many of
which are associated with keyboard shortcuts. Unfortunately, as this
tool has been developed over the years, I have not kept track of which
keys were assigned to which macros. I note that when I hit a certain
key board combination by accident, the program executes a macro. I want
to find out which macro is being executed without having to investigate
each of the macros individually.