VBA excel :Problème de bordure sous condition
Résolu/Fermé
A voir également:
- VBA excel :Problème de bordure sous condition
- Liste déroulante excel - Guide
- Si et excel - Guide
- Aller à la ligne excel - Guide
- Word et excel gratuit - Guide
- Excel compter cellule couleur sans vba - Guide
2 réponses
madeliocustom
Messages postés
41
Date d'inscription
mardi 11 mai 2010
Statut
Membre
Dernière intervention
23 avril 2012
13
11 mai 2010 à 19:04
11 mai 2010 à 19:04
Hello Jahawai,
essaye ca :
Sub tracedeslignes()
Dim dercol2 As Byte
Dim derline2 As Byte
dercol2 = Range("B2").End(xlToRight).Column
derline2 = Range("B2").End(xlDown).Row
Dim u As Byte
Dim j As Byte
'ligne du haut
For j = 2 To dercol2
Cells(2, j).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Next
'ligne du bas
For j = 2 To dercol2
Cells(derline2, j).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Next
'les autres lignes
For u = 2 To derline2
If (Cells(u - 1, 2).Value <> Cells(u, 2).Value) Then
For j = 2 To dercol2
Cells(u, j).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Next
End If
If (Cells(u + 1, 2).Value <> Cells(u, 2).Value) Then
For j = 2 To dercol2
Cells(u, j).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Next
End If
Next
End Sub
A+
Madelio
essaye ca :
Sub tracedeslignes()
Dim dercol2 As Byte
Dim derline2 As Byte
dercol2 = Range("B2").End(xlToRight).Column
derline2 = Range("B2").End(xlDown).Row
Dim u As Byte
Dim j As Byte
'ligne du haut
For j = 2 To dercol2
Cells(2, j).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Next
'ligne du bas
For j = 2 To dercol2
Cells(derline2, j).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Next
'les autres lignes
For u = 2 To derline2
If (Cells(u - 1, 2).Value <> Cells(u, 2).Value) Then
For j = 2 To dercol2
Cells(u, j).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Next
End If
If (Cells(u + 1, 2).Value <> Cells(u, 2).Value) Then
For j = 2 To dercol2
Cells(u, j).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Next
End If
Next
End Sub
A+
Madelio
Utilisateur anonyme
12 mai 2010 à 09:47
12 mai 2010 à 09:47
Salut Madelio,
Et merci beaucoup, effectivement, ça fonctionne.
Bonne journée,
Jahawai
Et merci beaucoup, effectivement, ça fonctionne.
Bonne journée,
Jahawai