Ajout commande dans le menu contextuel

Version imprimable

09/02/2019, 11h46
modus57

Ajout commande dans le menu contextuel

Bonjour.

J'ai besoin de votre aide s'il vous plait.

Je voudrais lancer une macro avec un Menu contextuel - clique droit de la souris.

Mais j'ai le message suivant qui s'affiche :
Impossible d'exécuter la macro "……'.Il est possible qu'elle ne soit pas disponible dans ce classeur ou que toutes les macros soient désactivées.

J'ai vérifié dans les options =>Centre de Gestion de la confidentialité=>Paramètres du Centre de Gestion de la confidentialité=>Paramètres des macros=>L'option Activer toutes les macros est activé.

Pourquoi ça ne fonctionne pas ?

Merci d'avance pour vos réponses
09/02/2019, 12h57
patricktoulon

re

re
bonjour modus
c'est toujours pareil il faut te tirer les vers du nez a chaque fois on est pas devain ,sans voir de code on avancera pas
poste ton code de ta commandbars ou commandbars modifiée et apres on verra

Bonjour patricktoulon

Je suis navré de ne pas avoir joint le code, le voici :

Code:

1
2
3
4
5
6
7
8
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("A34:A54")) Is Nothing Then
            With Application.CommandBars("cell").Controls.Add(Type:=msoControlButton, before:=6, temporary:=True)
               .Caption = "AJOUT LISTE LIBELLÉ"
               .OnAction = "Mod_AjoutListeLibelle"
            End With
    End If
End Sub

Ceux-ci dit, j'ai retrouvé un vieux classeur qui fonctionne en utilisant exactement cette procédure ?

re
la procedure tu l'a mise ou dans un module ou dans la feuille telle est la question n'est ce pas ;)
d'autant plus que a quelmoment tu la show cette popup puisque normalement quand tu le fait dans le change le popup d'origine ne s'affiche pas hein???

bon un petit exemple comme ca vite fait avec le clic droit sur les cells

j'attire ton attention sur le cancel et show popup
j'attire ton attention aussi comment est codé le ".onction"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True 'on annule l'affichage du menu cell
    'on ajoute l'item au menu cell
    With CommandBars("cell").Controls.Add(Type:=msoControlButton, before:=6, temporary:=True)
        .Caption = "AJOUT LISTE LIBELLÉ"
          .OnAction = "'Feuil1.Mod_AjoutListeLibelle " & Chr(34) & Target.Address & Chr(34) & "'" 'on appelle la macro qui est dans le module de la feuille elle meme et on lui script l'argument de l'adress de la target
    'donc l'item appelera la sub AVEC!!!!  argument
    End With
    CommandBars("cell").ShowPopup 'comme on l'a annuler il faut l'affifficher (showpopup)
 
    'quand tu aura selectionner ou pas et que le popup se sera fermer la commandbars("cell") revient a l'origine
    ' ainsi  quand tu fermera ton classeur et ouvrira un autre la barre cell sera d'origine
    CommandBars("cell").Reset
End Sub
 
Sub Mod_AjoutListeLibelle(adresse)
    MsgBox cel
    With Range(adresse)
    ' ce que tu veux ici
    End With
    MsgBox adresse
 
 
End Sub

oups!, j'ai oublié de le préciser.

Je l'ai mise dans la feuille, voici la procédure définitive :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    For Each icbc In Application.CommandBars("cell").Controls
        If icbc.Tag = "brcom" Then icbc.Delete
    Next icbc
 
    If Not Application.Intersect(Target, Range("A34:A54")) Is Nothing Then
            With Application.CommandBars("cell").Controls.Add(Type:=msoControlButton, before:=6, temporary:=True)
               .Caption = "AJOUT LISTE LIBELLÉ"
               .OnAction = "Mod_AjoutListeLibelle"
               .Tag = "brcom"
            End With
    End If
End Sub

1 pièce(s) jointe(s)

re
on s'est croisé regarde mon post précédent

et pour que ca corresponde a ce que tu voulais c'est a dire avec la condition A34:A54

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Not Application.Intersect(Target, Range("A34:A54")) Is Nothing Then
        Cancel = True    'on annule l'affichage du menu cell
        'on ajoute l'item au menu cell
        With CommandBars("cell").Controls.Add(Type:=msoControlButton, before:=6, temporary:=True)
            .Caption = "AJOUT LISTE LIBELLÉ"
            .OnAction = "'Feuil1.Mod_AjoutListeLibelle " & Chr(34) & Target.Address & Chr(34) & "'"    'on appelle la macro qui est dans le module de la feuille elle meme et on lui script l'argument de l'adress de la target
            'donc l'item appelera la sub AVEC!!!!  argument
        End With
        CommandBars("cell").ShowPopup    'comme on l'a annuler il faut l'affifficher (showpopup)
    End If
    'quand tu aura selectionner ou pas et que le popup se sera fermer la commandbars("cell") revient a l'origine
    ' ainsi  quand tu fermera ton classeur et ouvrira un autre la barre cell sera d'origine
    CommandBars("cell").Reset
End Sub
 
Sub Mod_AjoutListeLibelle(adresse)
    With Range(adresse)
        ' ce que tu veux ici
    End With
    MsgBox adresse
 
End Sub

ET TU PEUX meme mettre ta liste de liblés dans le popup
demo en feuille2

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Not Application.Intersect(Target, Range("A34:A54")) Is Nothing Then
        Cancel = True    'on annule l'affichage du menu cell
        'on ajoute l'item au menu cell
        With CommandBars("cell")
            Set pop = .Controls.Add(Type:=msoControlPopup, before:=6, temporary:=True)
            pop.Caption = "LISTE DE LIBELE"
            arrlibel = Array("toto", "titi", "riri", "fifi", "loulou")
            For i = LBound(arrlibel) To UBound(arrlibel)
                Set bout = pop.Controls.Add(Type:=msoControlButton, temporary:=True)
                bout.Caption = arrlibel(i)
                bout.OnAction = "'Feuil2.Mod_AjoutListeLibelle " & Chr(34) & arrlibel(i) & """,""" & Target.Address & Chr(34) & "'"     'on appelle la macro qui est dans le module de la feuille elle meme et on lui script l'argument de l'adress de la target
            Next
            'donc l'item appelera la sub AVEC!!!!  argument
        End With
        CommandBars("cell").ShowPopup    'comme on l'a annuler il faut l'affifficher (showpopup)
    End If
    'quand tu aura selectionner ou pas et que le popup se sera fermer la commandbars("cell") revient a l'origine
    ' ainsi  quand tu fermera ton classeur et ouvrira un autre la barre cell sera d'origine
    CommandBars("cell").Reset
End Sub
 
Sub Mod_AjoutListeLibelle(libel, adresse)
    With Range(adresse)
        ' ce que tu veux ici
    End With
    MsgBox "libélé : " & libel & "  dans " & adresse
 
End Sub

demo
Pièce jointe 448728

10/02/2019, 19h33
modus57

Bonsoir patricktoulon

Réponse comme dab :ccool: nickel chrome.

Merci beaucoup :applo: