Appliquer Bordure de ligne par code VBA

[sebgo]

Bonjour le forum,

Pour appliquer un formatage de ligne (griser une ligne sur deux) j'utilise ce bout de code qui marche bien

Sub FormaterLigne()
Dim i%
Dim j%
With Sheets("Recap")
For i = 4 To .Range("B65536").End(xlUp).Row Step 2
.Range("B" & i & ":G" & i).Interior.ColorIndex = 15
Next i
For j = 3 To .Range("B65536").End(xlUp).Row Step 2
.Range("B" & j & ":G" & j).Interior.ColorIndex = 2
Next j
End With

End Sub
En même temps pour appliquer un quadrillage de ligne (ou de plage c'est selon) j'utilise une MFC avec cette fonction trouvée sur Excelabo

Function NbLignesMaxiChamp(C As Range)
' Excelabo : Les astuces excel VBA du Disciplus.simplex
m = 0
For Each i In C
m = IIf(Cells(65536, i.Column).End(xlUp).Row > m, Cells(65536, i.Column).End(xlUp).Row, m)
Next i
NbLignesMaxiChamp = m - C.Row + 1
End Function

Il marche sauf que la MFC allourdit considérablement mon fichier, le faisant passer de 600 ko à 3 330 Ko. Une situation embettante pour moi.

Donc pour contourner la MFC je souhaite passer par la solution VBA. Quelqu'un (ou une) aurait-il un debut de reponse pour moi?
Merci par avance

 

[Robert]

Re : Appliquer Bordure de ligne par code VBA

Bonjour Sbgo, bonjour le forum,

un exemple de code, a placer après tes boucles, pour quadriller toute la plage :

Sub Macro1()
 
With Range("B4").CurrentRegion 'plage des cellules adjacentes à B4
 
    'bordure de gauche
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    'bordure du dessus
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    'bordure du dessous
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    'bordure de droite
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    'bordure des interlignes
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    'bordure des inter colonnes
    With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
 
End With
 
End Sub

 

[sebgo]

Re : Appliquer Bordure de ligne par code VBA

Bonjour Robert, le forum

Very good. 5/5. Très correct.
Bonne fin de W.E
Thank's.
A+

 

[Robert]

Re : Appliquer Bordure de ligne par code VBA

Bonjour Sebgo, bonjour le forum,

Heu 5/5 dis-tu... Regarde ce que me signale un p'tit malin de ce forum.

[LEFT][SIZE=2][COLOR=navy]Sub[/COLOR] Macro1()
    [COLOR=navy]With[/COLOR] Range("B4").CurrentRegion [COLOR=green]'plage des cellules adjacentes à B4[/COLOR]
        [COLOR=green]'Toutes les bordures[/COLOR]
        [COLOR=navy]With[/COLOR] .Borders  [COLOR=seagreen] 'sans rien derrière ![/COLOR]
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        [COLOR=navy]End With
    End With
End Sub[/COLOR][/SIZE][/LEFT]

En plus ce petit malin, il est tellement humble qu'au lieu de venir te le dire directement, il me l'a juste signalé par e-mail avec la gentillesse qui le caractérise. Alors là 10/10 pour ce grand Monsieur.

 

[Halffy]

Re : Appliquer Bordure de ligne par code VBA

Bonsoir Robert, Sebgo...
Je remonte le sujet pour remercier également l'Humble petit malin pour son code /
Exactement ce que je cherchais (avec une petite adaptation pour coler à mon sujet 😉); comme quoi l'historique a sa raison d'être 😀
Messieurs, le Forum, bien le bonsoir.
Halffy /.

 

[Naeva]

Re : Appliquer Bordure de ligne par code VBA

Bonjour,
Je viens de faire des recherches sur le forum et j'ai trouvé ce fils qui s'applique très bien à mon problème sauf que je voudrais que le code s'effectue comme il le fait sauf pour les lignes vides mais j'ai pas réussi à rajouter une ligne sur la vba malgré mes tests

voilà le code que je voulais rajouter
Range("A25:G57").Select
If Cells.Value = "" Then
Selection.Borders(xlDiagonalDown).LineStyle = xlNone

mais il me met une erreur d'execution 7 et me dit que ma mémoire est insuffisante