'palette coleur perso dans le menu contextuel "Cell"
'auteur patricktoulon
'***************************************************************
'Dans le module de la feuille
'Option Explicit
'Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'addBtcouleurMenuCell
'End Sub
'!!!!! ou le right click dans le module thisworkbook avec une classe event intra module thisworkbook!!!!!
'Option Explicit
'Public WithEvents feuille As Worksheet
'Private Sub Workbook_Open()
'Set feuille = ThisWorkbook.Sheets(1)
'End Sub
'Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Set feuille = Sh
'End Sub
'Private Sub feuille_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'addBtcouleurMenuCell
'End Sub
'***************************************************************
'dans un module standard
Sub addBtcouleurMenuCell()
Dim bt As Object
With CommandBars("Cell")
.Reset
Set bt = .Controls.Add(msoControlButton, , , 1, True)
With bt
.Caption = "Couleur +"
.FaceId = 962
.OnAction = "autreCouleur"
End With
End With
End Sub
Sub autrecouleur()
Dim OldCoul&
OldCoul = ThisWorkbook.Colors(1)
If Application.Dialogs(xlDialogEditColor).Show(1, 0, 0, 0) = True Then
ActiveCell.Interior.Color = ActiveWorkbook.Colors(1)
'si ta palette est d'origine(n'a pas déjà été modifiée )
ThisWorkbook.ResetColors
'si la palette a déjà été modifiée (que les 56 couleurs ne sont pas celles d'origine)
'ThisWorkbook.Colors(1) = OldCoul
End If
Application.CommandBars("Cell").Reset ' le bouton s'auto detruit
End Sub