Boucle mis en forme [Résolu/Fermé]

Signaler
-
 philippine -
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

Messages postés
31493
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
25 février 2021
3 281
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


Top ! Ca marche niquel.

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

Merci d'avance !!

Philippine
Messages postés
31493
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
25 février 2021
3 281
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

Top merci beaucoup !!