Macro pour copier couleur dégradée d'un cellule

[apnart]

Bonjour,

J'essais (en vain) par une macro, de copier le format d'une cellule. J'arrive bien à copier son contenu, la couleur de fond quand elle est unie, mais pas la couleur si elle est en dégradé (de 2 couleurs)...

Le but est d'avoir un menu dans le ruban, et quand je clique sur une icone, ça va me chercher le contenu d'une case dans un onglet appelé "Legende", pour le coller dans la zone que j'ai préalablement sélectionné.

J'ai testé ça qui marche sur une couleur unie :

Sub A16(ByVal control As IRibbonControl)
    Selection.Value = Sheets("Legende").Cells(16, 1).Value
    With Selection.Interior
        .ColorIndex = Sheets("Legende").Cells(16, 1).Interior.ColorIndex
        .Pattern = xlSolid
    End With
End Sub

Et ça qui ne veut pas fonctionner :

Sub A17(ByVal control As IRibbonControl)
'End Sub
    Selection.Value = Sheets("Legende").Cells(17, 1).Value
    With Selection.Interior
        .Pattern = Sheets("Legende").Cells(17, 1).Interior.Pattern
        .Gradient.Degree = Sheets("Legende").Cells(17, 1).Interior.Gradient.Degree
        .Gradient.ColorStops.Clear
    End With
    With Selection.Interior.Gradient.ColorStops.Add(0)
        .Color = Sheets("Legende").Cells(17, 1).Interior.Gradient.ColorStops.Add(0).Color
        .TintAndShade = Sheets("Legende").Cells(17, 1).Interior.TintAndShade
    End With
    With Selection.Interior.Gradient.ColorStops.Add(1)
        .Color = Sheets("Legende").Cells(17, 1).Interior.Gradient.ColorStops.Add(1).Color
        .TintAndShade = Sheets("Legende").Cells(17, 1).Interior.Gradient.ColorStops.Add(1).TintAndShade
    End With
End Sub

Côté ruban, pas de soucis, j'ai mes icones, ça réagit comme il faut.

Si vous avez un moyen de copier complètement les caractéristiques d'une cellule (contenu, police, gras ou non,couleur de fond, centrage du texte), je suis également preneur

Merci d'avance de votre aide,
Bruno.

 

[apnart]

Resolu : Macro pour copier couleur dégradée d'un cellule

Bon bah j'ai trouvé tout seul, j'ai changé d'approche, je suis reparti sur le "past special", et ça donne :

Sub A2(ByVal control As IRibbonControl)
    Sheets("Legende").Range("A2").Copy
    
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

si ça peut intéresser quelqu'un