VBA excel :Problème de bordure sous condition
Résolu
Utilisateur anonyme
-
Utilisateur anonyme -
Utilisateur anonyme -
Bonjour,
Je vous soumets un bout de code qui vise simplement à tracer des bordures horizontales dans un tableau, sous condition (à savoir que lorsque les cellules adjacentes de la première colonne sont identiques, pas de bordure). Ces cellules contiennent du texte.
Le résultat est que je trace des lignes horizontales partout dans mon tableau.
Je ne vois pas très bien ce qui peut rater...
Quelqu'un a t'il une idée ?
Merci
Je vous soumets un bout de code qui vise simplement à tracer des bordures horizontales dans un tableau, sous condition (à savoir que lorsque les cellules adjacentes de la première colonne sont identiques, pas de bordure). Ces cellules contiennent du texte.
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 For u = 2 To derline2 If Cells(u, 2).Value <> Cells(u + 1, 2).Value & Cells(u, 2).Value <> Cells(u - 1, 2).Value Then For j = 2 To dercol2 Cells(u, j).Select With Selection Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThick .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThick .ColorIndex = xlAutomatic End With Next End If Next
Le résultat est que je trace des lignes horizontales partout dans mon tableau.
Je ne vois pas très bien ce qui peut rater...
Quelqu'un a t'il une idée ?
Merci
A voir également:
- VBA excel :Problème de bordure sous condition
- Liste déroulante excel - Guide
- Word et excel gratuit - Guide
- Déplacer colonne excel - Guide
- Si ou excel - Guide
- Excel compter cellule couleur sans vba - Guide
2 réponses
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