Option Compare Text
Dim CopyGroup As Boolean
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Select Case True
Case Target.Count <> 2 ' Il faut 2 cellules
Case Target.Rows.Count <> 2 ' sur 2 lignes
Case Not Target.MergeCells ' Elles doivent être fusionnées
Case Not Target.Column = 4 ' en colonne 4
Case Not Target.Cells(1).HasFormula ' il faut une formule
Case Not Target.Cells(1).FormulaLocal Like "*decaler*" ' de type "décaler"
Case Else
Cancel = True ' on empêche Excel d'afficher le menu normal
' et on ajoute ses propres options au Menu Clic_Droit de la cellule
With Application.CommandBars("Cell")
With .Controls.Add(msoControlButton, 1, , 1, True)
.Caption = "copier ce groupe "
.FaceId = 19
.OnAction = Me.CodeName & ".Copier_Groupe"
End With
With .Controls.Add(msoControlButton, 1, , 2, True)
.Caption = "Insérer le groupe copié"
.Enabled = CopyGroup
.FaceId = 4173
.OnAction = Me.CodeName & ".Insérer_Groupe"
End With
With .Controls.Add(msoControlButton, 1, , 3, True)
' Ligne blanche
End With
.ShowPopup ' on affiche le menu
For Each Control In .Controls
If Not Control.BuiltIn Then Control.Delete ' On détruit les éléments ajoutés
Next
End With
End Select
End Sub
Sub Copier_Groupe()
Selection.EntireRow.Copy ' On copie les 2 lignes entières du Groupe
CopyGroup = True ' On indique qu'une copie de groupe est en cours
End Sub
Sub Insérer_Groupe()
Selection.EntireRow.Insert Shift:=xlDown ' On insère le groupe copié
Copier_Groupe ' On recharge le presse-papier
' pour pouvoir continuer à Insérer si besoin
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 4 Then
If CopyGroup Then
Application.CutCopyMode = False
CopyGroup = False
End If
End If
End Sub
