calculatrice & Menu contextuel clic droit souris

Halffy

XLDnaute Occasionnel
Bonjour à tous,
je recherche comment intégrer la calculatrice au Menu contextuel clic droit de la souris, dans Excel,
à l'image de mDF XLcalendar.
Si quelqu'un avait une idée, s'il vous plait?
Par avance, tous mes remerciements.

Je suis sous Excel Pro 2007.
PS: Je sais que je peux intégrer la calculatrice à la Barre de Menu...
Mais moi, je la voudrais dans le Menu Contextuel, si cela était possible.
Encore Merci.
 

david84

XLDnaute Barbatruc
Re : calculatrice & Menu contextuel clic droit souris

Bonsoir,
un test dans le classeur ci-joint adapté de cet exemple (l'icône de la calculatrice se trouve en 2ème position).
Attention : pour information concernant ceux qui veulent tester : le menu est chargé dès l'activation du classeur (et est effacé lors de sa désactivation).
Ci-joint le code à part pour ceux qui préfère le découvrir avant :
Dans un module de feuille :
Code:
'adapté de http://www.rondebruin.nl/win/s6/win001.htm
Option Explicit

Sub AddToCellMenu()
    Dim ContextMenu As CommandBar
    Dim MySubMenu As CommandBarControl


    'Delete the controls first to avoid duplicates
    Call DeleteFromCellMenu


    'Set ContextMenu to the Cell menu
    Set ContextMenu = Application.CommandBars("Cell")

    'Add one built-in button(Save = 3)to the cell menu
    ContextMenu.Controls.Add Type:=msoControlButton, ID:=3, before:=1

    'Add one custom button to the Cell menu
    With ContextMenu.Controls.Add(Type:=msoControlButton, before:=2)
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "Calculatrice"
        .FaceId = 50
        .Caption = "Calculatrice"
        .Tag = "Lancer_calculatrice"
    End With

End Sub


Sub DeleteFromCellMenu()
    Dim ContextMenu As CommandBar
    Dim ctrl As CommandBarControl

    'Set ContextMenu to the Cell menu
    Set ContextMenu = Application.CommandBars("Cell")
    
    For Each ctrl In ContextMenu.Controls
        If ctrl.Tag = "Lancer_calculatrice" Then
            ctrl.Delete
        End If
    Next ctrl

    'Delete built-in Save button
    On Error Resume Next
    ContextMenu.FindControl(ID:=3).Delete
    On Error GoTo 0
End Sub

Sub Calculatrice()
Dim X As Long
X = Shell("Calc.exe", 1)
End Sub

Dans le module ThisWorkbook :
Code:
Private Sub Workbook_Activate()    
Call AddToCellMenu
End Sub

Private Sub Workbook_Deactivate()
    Call DeleteFromCellMenu
End Sub
A+
 

Pièces jointes

  • calc_contextmenu.xls
    31 KB · Affichages: 73

Halffy

XLDnaute Occasionnel
Re : calculatrice & Menu contextuel clic droit souris

Bonsoir David84,

Merci de l'intérêt porté sur ma requête / c'est exactement ce que je cherchais à faire (sauf que j'en étais incapable)!
Toutefois... à un bémol près (et c'est de ma faute):
En fait, je souhaiterais que ce programme se charge à chaque ouverture d'Excel, et ce quelque soit le fichier que je vais ouvrir avec Excel (à l'image de mDF XLcalendar, qui a dû "transposer" son fichier en .xla, si je ne m'abuse).
Cela serait-il possible?
 

david84

XLDnaute Barbatruc
Re : calculatrice & Menu contextuel clic droit souris

Bonjour,

je t'ai livré l'idée de base et l'idée te convient : très bien mais j'attends de ta part que tu testes correctement...ce que tu n'as visiblement pas fait !

Si tu l'avais fait tu te serais aperçu que notamment :
- une nouvelle calculatrice s'ouvre à chaque clic droit+sélection de la calculatrice (donc 50 sélections=>50 calculatrices)
- la calculatrice ouverte ne se ferme pas à la fermeture du fichier.

Donc pour y remédier le code prévoyant ces 2 cas de figure (remplacer intégralement le précédent par celui-ci) :
dans le module :
Code:
'adapté de http://www.rondebruin.nl/win/s6/win001.htmOption Explicit
#If Win64 Then 'windows 64 bits
  Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
  Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
  (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
  lParam As Any) As Long
#Else 'windows 32 bits
  Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
  Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
  lParam As Any) As Long
#End If

Const WM_CLOSE As Long = &H10
Const SW_NORMAL As Long = 1

Sub AddToCellMenu()
    Dim ContextMenu As CommandBar
    Dim MySubMenu As CommandBarControl

    'Delete the controls first to avoid duplicates
    Call DeleteFromCellMenu

    'Set ContextMenu to the Cell menu
    Set ContextMenu = Application.CommandBars("Cell")

    'Add one built-in button(Save = 3)to the cell menu
    ContextMenu.Controls.Add Type:=msoControlButton, ID:=3, before:=1

    'Add one custom button to the Cell menu
    With ContextMenu.Controls.Add(Type:=msoControlButton, before:=2)
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "Calculatrice"
        .FaceId = 50
        .Caption = "Calculatrice"
        .Tag = "Lancer_calculatrice"
    End With

End Sub


Sub DeleteFromCellMenu()
    Dim ContextMenu As CommandBar
    Dim ctrl As CommandBarControl

    'Set ContextMenu to the Cell menu
    Set ContextMenu = Application.CommandBars("Cell")
    
    For Each ctrl In ContextMenu.Controls
        If ctrl.Tag = "Lancer_calculatrice" Then
            ctrl.Delete
        End If
    Next ctrl

    'Delete built-in Save button
    On Error Resume Next
    ContextMenu.FindControl(ID:=3).Delete
    On Error GoTo 0
End Sub

Sub Calculatrice()
Dim wCalc As Long
wCalc = FindWindow("CalcFrame", vbNullString)
If wCalc = 0 Then
  Shell "Calc.exe", SW_NORMAL
Else
  SetForegroundWindow wCalc
End If
End Sub

Sub Fermer_Calculatrice()
Dim wCalc As Long
wCalc = FindWindow("CalcFrame", vbNullString)
If wCalc <> 0 Then SendMessage wCalc, WM_CLOSE, 0, ByVal 0&
End Sub

Dans le ThisWorkbook :
Code:
Private Sub Workbook_Activate()    
Call AddToCellMenu
End Sub

Private Sub Workbook_Deactivate()
    Call DeleteFromCellMenu
    Call Fermer_Calculatrice
End Sub

Il y a peut-être d'autres cas à gérer mais c'est maintenant à toi de me les indiquer...en testant.

Une fois tout cela fait tu pourras envisager d'enregistrer ton fichier en .xlam afin de pouvoir l'utiliser comme macro complémentaire. Il y a plein d'explications sur le Net sur la manière de procéder.
A+
 

Halffy

XLDnaute Occasionnel
Re : calculatrice & Menu contextuel clic droit souris

Bonjour David84,
Je fais donc réponse / maintenant que j'ai enfin un peu de temps, pour cela :)
"j'attends de ta part que tu testes correctement...ce que tu n'as visiblement pas fait !
Si tu l'avais fait tu te serais aperçu que la calculatrice ouverte ne se ferme pas à la fermeture du fichier"


==> J'avais bien remarqué cette "anomalie", mais en fait cela ne me gênait pas plus que cela (pour le moment / chaque chose en son temps; il faut toujours faire preuve de patience).

Non, ce qui me gênait davantage, c'est que j'ai "trouvé" comment enregistrer ton travail (qui me convenait déjà fort bien, au passage) en .xlam... mais je n'arrivais, et n'arrive toujours pas à l'appliquer à Excel.
En fait vendredi, je me suis couché à 00h00 pour cela... mais rien à faire, cela ne veut pas!
Je vois bien la fichier .xlam dans les macros complémentaires / il est bien coché / il est enregistré à la bonne place (add in, voir dans la librairie (comme mFD XLCalendar), mais malgrés cela, suite au clic droit, je ne vois pas la "macro" de la calculatrice.

Mis à part cela, je te remercie de la correction aux problèmes rencontrés, c'est évidemment bien mieux comme cela / c'est beaucoup plus "propre". Superbe travail, je t'en remercie / Cela répond exactement à ma requête.

Toutefois, je ne comprends pas pourquoi je n'arrive toujours pas à l'enregistrer en macro complémentaire, et ce malgrés plusieurs entatives??
Alors je planche sur le sujet, je regarde, teste.
Et si enfin, j'y arrive, je ne manquerais pas de te le faire savoir :)
En attendant, encore tous mes remerciements pour ton remarquable travail.
Cordialement, Halffy /.
 

david84

XLDnaute Barbatruc
Re : calculatrice & Menu contextuel clic droit souris

Bonjour,
si jamais le but est de bénéficier de la calculatrice sur tous les fichiers remplacer l'événement Workbook_Activate par Workbook_Open et l'événement Workbook_Deactivate par Workbook_BeforeClose.
A+
 

Discussions similaires

Haut Bas