En VBA Excel, quelle(s) instruction(s) permet(tent) de savoir si un raccourci clavier est affecté à une macro (sub) ?

Question

bonjour,

En VBA EXCEL, quelle(s) instruction(s) permet de savoir si un raccourci clavier est affecté à une macro (sub) ?

j'ai trouvé cette macro, mais elle ne fonctionne pas dans excel 365 :

Sub ListeMacros()
Dim Macro As String, Racc As String
Dim Rpt As String, I As Integer

Application.ScreenUpdating = False
Workbooks.Add.Worksheets(1).[A1:B1] = [{"Procédure","Raccourci"}]

SendKeys "%{F8}%a{PGUP}{TAB}{ESC}"

'nécessite une référence à la bibliothèque
'Microsoft Forms 2.0 Object Library
With New DataObject
Do
Rpt = "%{F8}{TAB}" & Application.Rept("{DOWN}", I)
SendKeys Rpt & "%n^c{ESC}", True
.GetFromClipboard
If Macro = .GetText(1) Then Exit Do
Macro = .GetText(1)
SendKeys Rpt & "%t^c{ESC}{ESC}", True
.GetFromClipboard
Racc = .GetText(1)
I = I + 1
Cells(I + 1, 1) = Macro
If Racc <> Macro Then Cells(I + 1, 2) = "Ctrl-" & Racc
Loop
End With
With Columns("A:B")
.AutoFit
.Sort [A1], Header:=xlYes
.CurrentRegion.AutoFormat xlRangeAutoFormatColor2
End With
End Sub

Merci pour votre aide.

Bonne journée

Answer 1

Compris, la macro ne cherche que dans le classeur actif.

Pour chercher dans le classeur de macros personnelles, remplace :

Set vbProj = ActiveWorkbook.VBProject

par

Set vbProj = Workbooks("personal.xlsb").VBProject

Daniel

Answer 2

Les résultats devraient s'afficher dans la fenêtre exécution de l'éditeur VBA. Il faut que cette fenêtre soit ouverte :

Daniel

Answer 3

Daniel,

en complément, ma version installée :

Microsoft® Excel® pour Microsoft 365 MSO (Version 2201 Build 16.0.14827.20186) 64 bits

Windows 11

Merci d'avance

Answer 4

bonjour Daniel,

merci beaucoup

voilà les références que j'ai cochées. par erreur, j'avais coché la première mais quand j'essaie de décocher, voilà le message que j'ai :

sinon, avec les références cochées ci dessus, quand je lance la macro List_Macro_Shortcuts , il n'y a pas de résultat

merci d'avance pour votre aide

Answer 5

Bonjour,

J'ai ce code qui fonctionne. Il faut cocher les références :

• Microsoft Visual Basic for Applications Extensibility
• Microsoft Scripting Runtime
• Microsoft VBScript Regular Expressions 5.5

De plus, dans les options, centre de gestion de la confidentialité, Paramètres des macros, il faut cocher la case : "Accès approuvé au modèle objet du projet VBA".

Sub List_Macro_Shortcuts()
Dim vbProj As VBIDE.VBProject
Dim vbComp As VBIDE.VBComponent
Dim codeMod As CodeModule
Dim lineNum As Long
Dim procKind As VBIDE.vbext_ProcKind
Dim sProcName As String
Dim sShortCutKey As String
Dim fn As String
Dim s As String
Dim fso As FileSystemObject
Dim ts As TextStream
Dim re As RegExp
Dim mc As MatchCollection
Dim m As Match

fn = ThisWorkbook.Path & "\Temp.txt"  
Set re = New RegExp  

With re  
    .Global = True  
    .IgnoreCase = True  
    .Pattern = "Attribute\s+(\w+)\.VB\_ProcData\.VB\_Invoke\_Func = ""(\S+)(?=\\)"  
End With  

Set fso = New FileSystemObject  
Set vbProj = ActiveWorkbook.VBProject  
  
For Each vbComp In vbProj.VBComponents  
    Select Case vbComp.Type  
        Case Is = vbext\_ct\_StdModule  
            vbComp.Export fn  
            Set ts = fso.OpenTextFile(fn, ForReading, Format:=TristateFalse)  
            s = ts.ReadAll  
            ts.Close  
            fso.DeleteFile (fn)  
            If re.test(s) = True Then  
                Set mc = re.Execute(s)  
                For Each m In mc  
                    Debug.Print vbComp.Name, m.SubMatches(0), m.SubMatches(1)  
                Next m  
            End If  
    End Select  
Next vbComp  

End Sub

Note : les résultats apparaissent dans la fenêtre d'exécution.

Cordialement.

Daniel