VBA excel :Problème de bordure sous condition

Résolu/Fermé
Utilisateur anonyme - 11 mai 2010 à 18:15
 Utilisateur anonyme - 12 mai 2010 à 09:47
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.
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:

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
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
0
Utilisateur anonyme
12 mai 2010 à 09:47
Salut Madelio,

Et merci beaucoup, effectivement, ça fonctionne.
Bonne journée,

Jahawai
0