Discussion :

[Ashireon]

Bonjour à tous,

j'ai un problème j'ai suivi un tuto pour realiser une bouton dans le menu contextuel excel mais rien n'apparait.

voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub AddToCellMenu()
    Dim ContextMenu As CommandBar
    Dim MySubMenu As CommandBarControl
 
    Call DeleteFromCellMenu
 
    Set ContextMenu = Application.CommandBars("Cell")
    ContextMenu.Controls(4).BeginGroup = True
 
 
    ' Add one custom button to the Cell context menu.
    With ContextMenu.Controls.Add(Type:=msoControlButton, before:=2)
        .OnAction = "BoutonAllerA"
        .FaceId = 59
        .Caption = "aller au detail"
        .Tag = "My_Cell_Control_Tag"
    End With
 
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub Workbook_Activate()
'
AddToCellMenu
 
End Sub

Merci de m'aider à trouver ou je merdouille ? Se peut il que le contextmenu soit verouillé dans une quelconque option?

[parmi]

Bonjour,

Qu'est-ce qui ne fonctionne pas ?
J'ai utilisé ton code et il me met bien le menu en 2e position avec un "bonhomme sourire" à côté...

Est-ce que tu as un message d'erreur ?
Si oui, lequel et sur quelle ligne ?

[Ashireon]

Re,
Moi pas comprendre la macro fonctionne chez moi mais ne marche pas sur le fichier dont j'ai besoin au taffe.
Dans le fichier au boulot d'autres macros fonctionnent parfaitement.
???
Y a t il un paramètre qui permet de geler les commandbar etc???

[parmi]

Quelles sont les versions d'Office qui fonctionnent et ne fonctionnent pas ?
Est-ce que le feuille est protégée ? Je ne sais pas si ça a un impact, mais bon...

[Ashireon]

Re bonjour,
JE viens d'essayer dans un classeur vide en ayant enlever toutes les protections d'excel ca ne fonctionne pas ??
JE pense qu'il y a un paramètre paumés dans un coin.
JE suis sur Excel 2010 , à la maison ca fonctionne au boulot non .

[parmi]

Qu'en est-il des paramètres de sécurité dans Excel ?
Est-ce que les macros sont acceptées sans restriction ?

[Ashireon]

toutes les macros sont acceptes sans restriction , oui j'ai trouvé un autre myen de faire ce que je desirai mais en remplacant completement le menu contextuel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 
Dim FinTableau As Long
FinTableau = Sheets("recapitulatif").Range("B" & Rows.Count).End(xlUp).Row
 
If Not Intersect(Target, Range("B6:N" & FinTableau)) Is Nothing Then
      Application.CommandBars("cell").Reset
      Cancel = True 'empêche l'affichage du menu d'Excel
       CreatePopupMenu
 
      Else
 
     Application.CommandBars("Cell").Reset
    End If
 
 
 
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub CreatePopupMenu()
 Dim MaBarre As CommandBar
 DelPopupMenu
 Set MaBarre = Application.CommandBars _
    .Add(Name:="ClicDroit", Position:=msoBarPopup)
 With MaBarre
  .Controls.Add Type:=msoControlButton
  .Controls(1).OnAction = "detail"
  .Controls(1).Caption = "Detail"
 End With
 MaBarre.ShowPopup
 End Sub

Ca fonctionne mais du coup dans la plage du tableau je n'ai plus les fonctions habituels

[parmi]

Qu'est-ce qu'il y a comme code dans DelPopupMenu ?

[Ashireon]

Et bien il y a ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub DelPopupMenu()
    On Error Resume Next
        Application.CommandBars("ClicDroit").Delete
 End Sub

[parmi]

Voici un exemple comment je l'utilise
Dans la feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
30
31
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    EffacerMenus
    Dim MonNombre As Long
    Dim MaChaine As String
 
    'Pour tests paramètres
    MonNombre = 25
    MaChaine = "Allo"
 
    'Ajoute les menus si dans la plage C4:E13
    If Not Application.Intersect(Target, Range("C4:E13")) Is Nothing Then
        With Application.CommandBars("cell").Controls _
            .Add(Type:=msoControlButton, before:=1, temporary:=True)
                .Caption = "*** Fonction 2"
                .OnAction = "'Fonction2 " & MonNombre & "'"
                .Tag = "Fonction2"
        End With
 
        With Application.CommandBars("cell").Controls _
            .Add(Type:=msoControlButton, before:=1, temporary:=True)
                .Caption = "*** Fonction 1"
                .OnAction = "'Fonction1 """ & MaChaine & """'"
                .Tag = "Fonction1"
        End With
    End If
 
End Sub
 
Private Sub Worksheet_Deactivate()
    EffacerMenus
End Sub

Dans ThisWorkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    EffacerMenus
End Sub
 
Private Sub Workbook_Deactivate()
    EffacerMenus
End Sub

Dans un module standard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub EffacerMenus()
    Dim Menu As Variant
 
    For Each Menu In Application.CommandBars("cell").Controls
        If Menu.Tag = "Fonction1" Or _
           Menu.Tag = "Fonction2" Then Menu.Delete
    Next Menu
End Sub
 
Sub Fonction1(lettre As String)
    MsgBox lettre
End Sub
 
Sub Fonction2(chiffre As Long)
    MsgBox chiffre
End Sub

[Ashireon]

Ca ne fonctionne pas au bouot mais je suis sur que chez moi ca va fonctionner ta macro.
Je pense que c'est lie au parametre d'excel.

Je ne peux pas modifier la barre mais je peux la désactiver et avoir mon propre menu popup.

Par contre j'ai le menu d'edition de texte toujours au dessus et en dessous du menu contextuel d'excel. Ce que je n'ai pas chez moi.
C'est peut être cela qui me bloque la modification menu contextuel.

[parmi]

Assure-toi aussi de ne pes être en "aperçu des sauts de pages" qui empêche le bon fonctionnement.

J'ai vu aussi que le fichier Excel.xlb pouvait causer un problème (corrompu ?)
Il s'agit de fermer Excel, le supprimer et réouvrir Excel pour en créer un tout neuf qui fonctionne bien.
Fais une copie de sauvegarde au cas où avant de l'effacer.
Ici, il se trouve dans le répertoire
C:\Users\NOM DU USER\AppData\Roaming\Microsoft\Excel

[Ashireon]

Hello,
Donc je suis sous XP au boulot et pas de fichiers .xlb?
une autre idée

[parmi]

Sous XP, le chemin devrait être du genre
C:\Documents and Settings\nom d'utilisateur\Application Data\Microsoft\Excel

[Ashireon]

ET bien après des recherches infructueuses , je n'ai pas de fichiers .xlb.
Apparemment ce n'est pas automatique d'en avoir un excel en génère un si on fait de la personnalisation de barre ( et vu qu'il ne me les fait pas via VBA) du coup j'en ai pas.

Je continue a chercher...

[Ashireon]

Bonjour à tous,
Apres des déboires sur ma machine au boulot et une restauration système à présent cela fonctionne.

Cependant j'ai une erreur etrange

Le code s'active hors de la plage voulue

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 
Dim FinTableau As Long
FinTableau = Sheets("recapitulatif").Range("B" & Rows.Count).End(xlUp).Row
 
 
If Not Intersect(Target, Range("B6:O" & FinTableau)) Is Nothing Then
         Application.CommandBars("cell").Reset
        With Application.CommandBars("cell").Controls _
            .Add(Type:=msoControlButton, before:=1, temporary:=True)
                .Caption = "*** Detail"
                .OnAction = "Detail"
                .Tag = "Fonction2"
        End With
 
        With Application.CommandBars("cell").Controls _
            .Add(Type:=msoControlButton, before:=1, temporary:=True)
                .Caption = "*** FErmer les onglets"
                .OnAction = "FermerOnglet"
                .Tag = "Fonction1"
        End With
 
 
    End If
 
 
End Sub

j'avais quasiment le même code pour supprimer le menu contextuel et le remplacer cela fonctionnait dans la plage recherchée.
La ca fonctionne mais hors plage ??

[parmi]

En tout début de procédure, tu dois effacer les menus

[Ashireon]

Bonjour,
Et merci à toi pour le temps que tu consacres sur mon problème.

j'ai donc ajouter en debut de procedure la commande

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.CommandBars("Cell").Reset

Mais la du coup le contextmenu n'est jamais modifié ais alors que le code ci dessous quoique different lui fonctionne la grosse différence est le fait que je tue le contextmenu pour m'en creer un au lieu de modifier l'existant ( ce que je préférerai)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 
Dim FinTableau As Long
FinTableau = Sheets("recapitulatif").Range("B" & Rows.Count).End(xlUp).Row
 
If Not Intersect(Target, Range("B6:N" & FinTableau)) Is Nothing Then
      Application.CommandBars("cell").Reset
      Cancel = True 'empêche l'affichage du menu d'Excel
       CreatePopupMenu
 
      Else
 
     Application.CommandBars("Cell").Reset
    End If
 
End Sub

[parmi]

En fait, tu dois mettre DelPopupMenu ou EffacerMenus selon lequel tu utilises avant de créer tes menus dans BeforeRightClick()
Donc en tout début de procédure

[Ashireon]

Excuses moi de répondre tardivement , vu le boulot.
Apres avoir testé ça ne fonctionne pas non plus.
En fait je pense que ça bug du fait que la zone ou je veux ajouter mes bouton dans le menu contextuel est dans un tableau.
Du coup y a t il une règle a propos du menu contextuel et d'un tableau excel?

Qu'en penses tu ?