Boucle mis en forme

Résolu
Bonjour,

je cherche a faire un boucle qui colorie en vert et met des bords (un en haut deux en bas) sur toute la ligne de cette cellule si cette cellule n'est pas vide.

je suis trés nulle en VBA mais j'ai essayé ce code (qui ne marche pas evidemment)

Dim derniereLigne As Long
derniereLigne = Range("A" & Rows.Count).End(xlUp)
Range("A7").Select

Dim c As Variant

For Each c In Range(Cells(7, 1), Cells(derniereLigne, 1))
If c.Value <> "" Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092492
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

End If

Next c

Pouvez vous m'aider :D ??

Merci

2 réponses

  1. Top ! Ca marche niquel.

    Et si je veux colorer toute la ligne de cette cellule ?

    Merci d'avance !!

    Philippine
    1. Modérateur
      Sub test()
      Dim c As Variant
      Dim rng As Range
      
      Dim derniereLigne As Long
      derniereLigne = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
      
      Set rng = ActiveSheet.Range(Cells(7, 1), Cells(derniereLigne, 1))
      
      
      For Each c In rng
       If c.Value <> "" Then
         ligncell = c.Row
         With Rows(ligncell).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 10092492
            .TintAndShade = 0
            .PatternTintAndShade = 0
       End With
      
       With Rows(ligncell).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
       End With
       
       With Rows(ligncell).Borders(xlEdgeBottom)
            .LineStyle = xlDouble
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
       End With
       Rows(ligncell).Borders(xlEdgeRight).LineStyle = xlNone
       Rows(ligncell).Borders(xlInsideVertical).LineStyle = xlNone
       Rows(ligncell).Borders(xlInsideHorizontal).LineStyle = xlNone
      
       End If
      
      Next c
      
      End Sub
      
      
    2. Top merci beaucoup !!
  2. Modérateur
    Bonjour,

    essaye ça :
    Sub test()
    Dim c As Variant
    Dim rng As Range
    
    Dim derniereLigne As Long
    derniereLigne = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    
    Set rng = ActiveSheet.Range(Cells(7, 1), Cells(derniereLigne, 1))
    
    
    For Each c In rng
     If c.Value <> "" Then
       With c.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .Color = 10092492
          .TintAndShade = 0
          .PatternTintAndShade = 0
     End With
    
     With c.Borders(xlEdgeTop)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
     End With
     
     With c.Borders(xlEdgeBottom)
          .LineStyle = xlDouble
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThick
     End With
    
     c.Borders(xlEdgeRight).LineStyle = xlNone
     c.Borders(xlInsideVertical).LineStyle = xlNone
     c.Borders(xlInsideHorizontal).LineStyle = xlNone
    
     End If
    
    Next c
    
    End Sub