Créer une Diagonale en jaune

[bloomby]

Bonjour,

j'aimerais Créer une diagonale en Jaune (de la cellule A1 à la cellule ZZZ10000)
Bref, le max que Excel2007 permet

Le haut de la diagonal en bleu
et le bas en noire, comme dans l'exemple;

j'ai commencé et je me suis dit que si quelqu'un serait capable de créer une macro pour faire cette tâche, je gagnerais beaucoup de temps

 

[BOISGONTIER]

Re : Créer une Diagonale en jaune

Bonjour,

Sub essai()
  CreeShapes Range("B2"), "texte1", "texte2"
  CreeShapes Range("E3"), "texte3", "texte4"
End Sub


Sub CreeShapes(c, texte1, texte2)
   On Error Resume Next
   ActiveSheet.Shapes(c.Address & "1").Delete
   ActiveSheet.Shapes(c.Address & "2").Delete
   With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
       Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
       .OLEFormat.Object.Characters.Text = texte1
       .OLEFormat.Object.Characters.Font.Size = 7
       .Fill.ForeColor.RGB = RGB(255, 0, 0)
       .Line.ForeColor.RGB = RGB(255, 0, 0)
       .IncrementRotation 180
        .Name = c.Address & "1"
    End With
    With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
      Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
      .OLEFormat.Object.Characters.Text = texte2
      .OLEFormat.Object.Characters.Font.Size = 7
      .Fill.ForeColor.RGB = RGB(0, 255, 0)
      .Line.ForeColor.RGB = RGB(0, 255, 0)
      .Name = c.Address & "2"
    End With
End Sub

JB
Formation Excel VBA JB