Menu souris perso LMA, STephane, André

F

FDinguirard

Guest
Bonjour,

Ce fichier ci-joint a pour but de faciliter la saisie en colonnes. Je m'explique : la colonne contient des valeurs (noms de clients) qui changent peu.

L'utilisateur ne veut pas faire clic droit + liste de choix, mais clic droit + nom déjà saisi au dessus. Ce besoin nous vient de LMA.

Le fichier joint le résoud sur mon poste.

PB : chez andre cela plante en erreur :

"L'erreur suivante est signalée : -2147467259 (80004005), aux les lignes
suivantes :
With Application.CommandBars("cell").Controls _
.Add(Type:=msoControlButton, before:=6, _
temporary:=True)
"
Stéphane, peux tu nous éclairer car j'y perds mon latin. S'agit il d'un pb de références externes ?
 

Pièces jointes

  • menusouris.xls
    38 KB · Affichages: 80
T

Ti

Guest
André a, si je ne me trompe, une version néerlandaise d'Excel, il faut peut-être aller voir de ce côté, son menu cellule porte peut-être un autre nom. Il faudrait qualifier ce menu par son ID pour voir si ça ne vient pas de cela. En tout cas chez moi, ça marche bien.
 
A

andré

Guest
Ti, pas de racisme s'il te plait !
J'essaie déjà d'écrire sans faute, ce qui n'est pas simple, tu auras pu le constater de visu chez d'autres.
Normalement Excel traduit tout.
Ce problème ne s'est jamais produit avec Celada, qui elle travaille en anglais, ni avec mes pièces jointes qui sont pourtant écrites en néerlandais.
Je vérifie quand même, et j'appelle ce programme sur une autre "bécane" qui elle "pédale" en français.
Je vous tiens tous au courant.
Bon week-end.
André
 
A

andré

Guest
Je viens d'essayer sur une version française, même problème :
Erreur -2147461259(80004005) aux lignes :
With Application.CommandBars("cell").Controls _
.Add(Type:=msoControlButton, before:=6, _
temporary:=True)
Je travaille sur Windows 98 et Excel 2000
André
 
T

Ti

Guest
Effectivement cette astuce m'a paru très intéressante. J'en ai profité pour réécrire un peu le code, en le rendant plus rapide et plus "général" (le type d'origine des valeurs recopiées n'est plus modifié)
Concernant les problèmes rencontrés par André, ils viennent peut-être effectivement de la Référence à Microsoft Office 8,0 Object Library, supprimé dans ce fichier.
De toute façon, en cas de problème de ce type, le plus simple est de tout recopier dans un nouveau fichier vierge.
 

Pièces jointes

  • menusourisTi.xls
    43 KB · Affichages: 84
A

andré

Guest
J'ai essayé de recopier, mais cela ne marche pas (du moins je ne parviens pas à la faire fonctionner).
Je puis toujours m'équiper en XP, l'astuce en vaut vraiment la peine, mais, en attendant, cette procédure ne peut-elle pas être adaptée pour ceux qui travaillent encore dans une version précedente?
André.
 
M

MacrophageXL

Guest
Bonjour Ti,

Je réponds à ta question sur l'utilité de la ligne de test intersect.etc... dans ma version originale.

Je voulais m'assurer avant de toucher au menu souris que le pointeur était sur les cellules et non pas sur des zones grises hors plages de cellules.

Or je m'aperçois avec ta macro qu'effectivement ce test ne sert à rien.

J'en déduis que l'évènement before right click n'est vrai que sur la zone de plage de cellules d'une feuille.

QUESTION : COMMENT faire pour que cette gestion événementielle du clic droit soit valable sur tout le classeur quel que soit le nombre d'onglets ajoutés par l'utilisateur ? On ne peut pas demander à un utilisateur de répliquer le code de la macro sur chaque onglet...
 
T

Ti

Guest
Pour rendre l'événement disponible dans toutes les feuilles il faut passer par l'événement Workbook_sheetbeforerightclick. Donc la procédure de la feuil1 est à recopier dans la feuille ThisWorkBook, puis bien sûr la procédure de feuil1 est à supprimer.

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Ctrl As CommandBarControl
Dim Cel As Range, Plage As Range
Dim NbItem As Long, Boucle As Long
Dim DejaPris As Boolean

For Each Ctrl In Application.CommandBars("cell").Controls
If Ctrl.Tag = "brccm" Then Ctrl.Delete
Next Ctrl
With ActiveCell
If .Row = 1 Then Exit Sub
ReDim ListItem(1 To .Row)
Set Plage = Range(Cells(1, .Column), .Offset(-1, 0))
End With

For Each Cel In Plage
'inutile de boucler au delà de NbItem, le reste sera vide !
For Boucle = 1 To NbItem
If Cel.Value = ListItem(Boucle) Then
DejaPris = True
Exit For
End If
Next Boucle

If Not DejaPris And Cel.Value <> "" Then
NbItem = NbItem + 1
ListItem(NbItem) = Cel.Value
With Application.CommandBars("cell").Controls _
.Add(Type:=msoControlButton, before:=6, temporary:=True)
.Caption = CStr(Cel.Value)
.OnAction = "EcrisValeur(" & NbItem & ")"
.Tag = "brccm"
End With
End If
DejaPris = False
Next Cel

End Sub
 

Membres actuellement en ligne

Statistiques des forums

Discussions
314 655
Messages
2 111 605
Membres
111 217
dernier inscrit
aladinkabeya2