Sub MenueMakroErmitteln()  
' Ermitteln, wie ein MenüMakro heisst und _  
  in welcher Vorlage es gespeichert ist.  
' Fängt Fehler bei  
On Error Resume Next 
Dim cbTest As CommandBar 
Dim ctlTest As CommandBarControl 
Dim strRet, msg, strProz, strLeiste As String 
Dim iRet As Integer 
strLeiste = "Test"
' Für eine Symbolleiste "Test"  
Set cbTest = CommandBars(strLeiste)
If cbTest Is Nothing Then 
  MsgBox "Symbolleiste >" & strLeiste & "< nicht gefunden!", vbCritical, "Fehler"
  Exit Sub 
End If 
' Für die Menüleiste  
'Set cbTest = CommandBars("Menu Bar")  
For Each ctlTest In cbTest.Controls
' Für den Menüleisteneintrag "Eigenes"  
'For Each ctlTest In cbTest.Controls("Eigenes").Controls  
  ' Nur für eingene Makros  
  With ctlTest
    If .BuiltIn = False Then 
      msg = .Index & ".Eintrag:" & vbCrLf 
      msg = msg & "Name:" & vbTab & .Caption & vbCrLf 
      strProz = Right(.OnAction, Len(.OnAction) - InStr(1, .OnAction, "."))
      msg = msg & "Makro:" & vbTab & strProz & vbCrLf 
      strMod = Left(.OnAction, InStr(1, .OnAction, ".") - 1)
      msg = msg & "Modul:" & vbTab & strMod & vbCrLf 
      strRet = fkt_IstFVVorhanden(strMod)
      msg = msg & "Vorlage:" & vbTab & strRet & vbCrLf 
      If .Index = cbTest.Controls.Count Then 
        msg = msg & vbCrLf 
        iRet = MsgBox(msg, vbInformation, "Makronamen im Menü ermitteln")
      Else 
        msg = msg & vbCrLf & vbCrLf & vbTab & "Nächster Eintrag?"
        iRet = MsgBox(msg, vbYesNo, "Makronamen im Menü ermitteln")
        If iRet = 7 Then Exit Sub 
      End If 
    End If 
  End With 
Next ctlTest
Set cbTest = Nothing 
End Sub  

Public Function fkt_IstFVVorhanden(ByVal strProz As String) As String  
Dim MyProj  As VBProjects 
Dim MyComp  As VBComponents 
Dim MyComp2  As VBComponent 
Dim i, j As Integer 
fkt_IstFVVorhanden = "->Nicht vorhanden<-"
On Error Resume Next 
Set MyProj = Application.VBE.VBProjects
For i = 1 To MyProj.Count
  Set MyComp = Application.VBE.VBProjects(i).VBComponents
  If Not MyComp Is Nothing Then 
    For j = 1 To MyComp.Count
      If MyComp(j).Name = strProz And MyComp(j).Name <> "" Then 
        fkt_IstFVVorhanden = MyProj(i).Name & ".dot"
        Exit Function 
      End If 
    Next j
  End If 
Next i
End Function