Discussion :

[tomtom09]

Bonjour à tous,
Je viens vers vous concernant un problème que je n'arrive pas à résoudre.

1er Problème :
Insérer un lien hypertexte en mode partagé : résolu via une macro OK

2ieme problème :
Offrir l'option "lien hypertexte" via le menu contextuel clic droit en ajoutant un texte : OK

3ième problème :
En cliquant sur le menu contextuel, la macro s'effectue 2 fois et c'est la que le bas blesse.....

Vous trouverez ci-joint le code associé.

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
32
33
34
35
36
37
38
39
40
 
'Dans ThisWorkbook
Private Sub Workbook_Open()
 
'Menu accessible quand on fait le clique avec le bouton de droit dans une cellule
 Dim cBut As CommandBarButton
 
 'On efface le menu
Application.CommandBars("Cell").Reset
Set cBut = Application.CommandBars("Cell").Controls.Add(temporary:=True)
 
'On le remet
 With cBut
    .BeginGroup = True
    .Caption = "Insérer liens vers Dossier"
    .Style = msoButtonIconAndCaption
    .FaceId = 643
 
    .OnAction = "Feuil1.test()"
 
 End With
 On Error GoTo 0
 Application.EnableEvents = True
 End Sub
 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
 'A la fermeture du fichier, on élimine les libellés crées auparavants.
On Error Resume Next
    Application.CommandBars("cell").Reset
 
End Sub
 
'Dans Feuil1
Private Sub test()
 
MsgBox "test"
 
End Sub

Je fais donc appel à vous et vous remercie d'avance pour vos réponses.

[tomtom09]

Solution trouvée !!

Cela vient tout simplement de la syntaxe:

Code :

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

1
2
3
4
5
 
'ancienne ligne de code
.OnAction = "Feuil1.test()"
'nouvelleligne de code
.OnAction = "Feuil1.test"

Le faite d'enlever () à la fin de la macro faite en sorte que la macro n'est pas activée 2 fois.

Le code devient donc

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
 
'Dans ThisWorkbook
Private Sub Workbook_Open()
 
'Menu accessible quand on fait le clique avec le bouton de droit dans une cellule
 Dim cBut As CommandBarButton
 
 'On efface le menu
Application.CommandBars("Cell").Reset
Set cBut = Application.CommandBars("Cell").Controls.Add(temporary:=True)
 
'On le remet
 With cBut
    .BeginGroup = True
    .Caption = "Insérer liens vers Dossier"
    .Style = msoButtonIconAndCaption
    .FaceId = 643
     .OnAction = "Feuil1.test"
 End With
 On Error GoTo 0
 Application.EnableEvents = True
 End Sub

Si cela peut aider!!