XL 2013 Rajouter une bordure noire dans un tableau par VBA

onyirimba

XLDnaute Occasionnel
Supporter XLD
Bonjour,

J'ai crée une VBA qui crée un tableau dans l'onglet "SYNTHESE" en intégrant des données provenant de d'autres tableau (onglets bleu ciel ci-dessous)
Je souhaite rajouter une bordure noire dans un tableau par VBA mais je n'y arrive pas. La bordure noire doit séparer les informations situées entre 2 onglets bleu ciel :

Est-ce que vous pouvez m'aider ?
J'ai joint un fichier Excel illustratif
Merci de votre aide
1651828379740.png

Voici la VBA que j'ai codé :
Sub test()


'''xxxxxxxxxxxxxxxxx EFFACEMENT DES DONNEES EXIXTANTES xxxxxxxxxxxxxxxxxxxx'''''
ThisWorkbook.Activate
Sheets("SYNTHESE").Select
Range("B7:N100000").Select
Selection.Clear

'''xxxxxxxxxxxxxxxxx EFFACEMENT DES DONNEES EXIXTANTES xxxxxxxxxxxxxxxxxxxx'''''




Dim Titre, dt As Integer, ws As Worksheet, cel As Range, n As Integer
Dim nbLignes As Long





', dest As Range
Dim Deb As Long
Set ws = ThisWorkbook.Worksheets("SYNTHESE")
Dim Sh As Worksheet, C As Range


For Each Sh In Sheets
If Sh.Tab.ColorIndex = 33 Then

'''''''''''''''''''''''''' RISK '''''''''''''


For Each cel In Sh.Range("A7:A" & Sh.Range("A" & Rows.Count).End(xlUp).Row)

dt = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1

ws.Range("B" & dt) = cel.Offset(, 0)
ws.Range("C" & dt) = cel.Offset(, 1)
ws.Range("D" & dt) = cel.Offset(, 2)
ws.Range("E" & dt).Formula = ws.Range("X" & dt).Formula
ws.Range("F" & dt).Formula = ws.Range("Y" & dt).Formula
ws.Range("G" & dt).Formula = ws.Range("Z" & dt).Formula
ws.Range("H" & dt).Formula = ws.Range("AA" & dt).Formula
ws.Range("I" & dt).Formula = ws.Range("AB" & dt).Formula
ws.Range("J" & dt).Formula = ws.Range("AC" & dt).Formula
ws.Range("K" & dt).Formula = ws.Range("AD" & dt).Formula
ws.Range("L" & dt).Formula = ws.Range("AE" & dt).Formula
ws.Range("M" & dt).Formula = ws.Range("AF" & dt).Formula
ws.Range("N" & dt).Formula = ws.Range("AG" & dt).Formula

Next cel


'''''''''''''''''''''''''' RISK '''''''''''''


End If
Next Sh


''''''''''''''''''''''''''''''''''ALIGNEMENT DE LA CELLULE B à N'''''''''''''''''''''''
''''''''''''''''''''''''''''''''''ALIGNEMENT DE LA CELLULE B à N'''''''''''''''''''''''

''''''''''''''''''''''''''''''''''ALIGNEMENT DE LA CELLULE B à N'''''''''''''''''''''''

Range("B7:N10000").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With

''''''''''''''''''''''''''''''''''ALIGNEMENT DE LA CELLULE B à N'''''''''''''''''''''''
''''''''''''''''''''''''''''''''''ALIGNEMENT DE LA CELLULE B à N'''''''''''''''''''''''

''''''''''''''''''''''''''''''''''ALIGNEMENT DE LA CELLULE B à N''''''''''''''''''''''''


''''''''''''''''''''''''''''''''''mettre les cellules à "-"''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''mettre les cellules à "-"''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''mettre les cellules à "-"''''''''''''''''''''''''

Range("E7:N10000").Select
Application.CutCopyMode = False
Selection.Style = "Comma"
Selection.NumberFormat = _
"_-* #,##0.0 _€_-;-* #,##0.0 _€_-;_-* ""-""?? _€_-;_-@_-"
Selection.NumberFormat = "_-* #,##0 _€_-;-* #,##0 _€_-;_-* ""-""?? _€_-;_-@_-"


''''''''''''''''''''''''''''''''''mettre les cellules à "-"''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''mettre les cellules à "-"''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''mettre les cellules à "-"''''''''''''''''''''''''

''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE
''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE
''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE
''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE


ThisWorkbook.Sheets("MODELE").Range("A3:M4").Copy
With ws.Range("B1:N10000")
For i = 7 To dt
If .Range("B" & i) <> "Totalazerty" And .Range("B" & i) <> "" Then
.Rows(i).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next i
End With


''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE
''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE
''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE

Range("P10").Select


End Sub
 

Pièces jointes

  • 1651826938019.png
    1651826938019.png
    157.8 KB · Affichages: 32
  • 1651827305919.png
    1651827305919.png
    124.4 KB · Affichages: 31
  • Suivi Stock MCO RGPT - Copie Copie.xlsm
    721.7 KB · Affichages: 3
Dernière édition:

Lolote83

XLDnaute Barbatruc
Bonjour,
Sans VBA avec une simple MFC (Mise en Forme Conditionnelle) peut être.
Sélectionner la cellule B7 et faire
Accueil -> Mise en forme conditionnelle -> Nouvelle règle -> Utiliser une formule pour déterminer .....
puis saisir ce qui apparait sur la copie d'écran ci-dessous.
Ici, le soulignement est ROUGE, mais on peut choisir la couleur que l'on souhaite.

1651840689811.png


Voici le résultat

1651840785777.png


@+ Lolote83
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 837
dernier inscrit
Ugo