Probleme bouton perso vba menu contextuel

Version imprimable

Voir 40 message(s) de cette discussion en une page

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:

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:

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?

22/09/2014, 17h09
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 ?
22/09/2014, 21h08
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???
23/09/2014, 00h02
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...
23/09/2014, 10h42
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 .
23/09/2014, 11h29
parmi

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

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:

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:

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

23/09/2014, 15h28
parmi

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

Et bien il y a ceci

Code:

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

Voici un exemple comment je l'utilise
Dans la feuille

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
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:

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:

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

23/09/2014, 17h56
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.
23/09/2014, 18h21
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
24/09/2014, 07h54
Ashireon

Hello,
Donc je suis sous XP au boulot et pas de fichiers .xlb?
une autre idée
24/09/2014, 11h31
parmi

Sous XP, le chemin devrait être du genre
C:\Documents and Settings\nom d'utilisateur\Application Data\Microsoft\Excel
24/09/2014, 12h42
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...

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:

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 ??

02/10/2014, 16h51
parmi

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

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:

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:

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

03/10/2014, 14h22
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
07/10/2014, 21h15
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 ?

Voir 40 message(s) de cette discussion en une page