Rajouter une bordure noire dans un tableau par VBA Résolu/Fermé

Question

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 tableaux (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 : https://www.transfernow.net/dl/20220506lwZ8FzFK/KqP7JK6E Merci de votre aide 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 EDIT : Ajout des balises de code (la coloration syntaxique). Explications disponibles ici : ICI Merci d'y penser dans tes prochains messages. Configuration: Windows / Chrome 101.0.4951.54

Patrice33740 · Answer

Bonjour, Avec un fichier exemple, c'eût été plus simple ... J'ai pas tout compris, notamment pourquoi copier les formules et pourquoi copier 2 lignes de formats. Bref j'ai simplement repris la même méthode (qui me semble très lourde) et ajouté le trait manquant Ça donne quelque chose comme : Option Explicit Sub test() ' Dim wsh As Worksheet ' feuille (de calcul) Dim wsS As Worksheet ' feuille Synthèse Dim cel As Range ' cellule Dim noL As Long ' numéro de ligne Dim drL As Long ' dernière ligne Dim ofL As Long ' offset ligne Set wsS = ThisWorkbook.Worksheets("SYNTHESE") ' Effacement des données et bordures existantes wsS.Range("B7:N100000").Clear wsS.Range("A7:A100000").Borders.LineStyle = xlLineStyleNone ' Copie des données et formules For Each wsh In ThisWorkbook.Worksheets With wsh If .Tab.ColorIndex = 33 Then ' Risk For Each cel In .Range("A7", .Cells(Rows.Count, "A").End(xlUp)).Cells drL = wsS.Cells(Rows.Count, "B").End(xlUp).Row + 1 ' données wsS.Cells(drL, "B").Value = cel.Offset(, 0).Value wsS.Cells(drL, "C").Value = cel.Offset(, 1).Value wsS.Cells(drL, "D").Value = cel.Offset(, 2).Value ' formules For ofL = 0 To 9 wsS.Cells(drL, "E").Offset(ofL).Formula = wsS.Cells(drL, "X").Offset(ofL).Formula Next ofL Next cel ' séparateur (uniquement en colonne "A" car la mise en page écrase les formats de B à N) wsS.Cells(drL, "A").Borders(xlEdgeBottom).LineStyle = xlContinuous wsS.Cells(drL, "A").Borders(xlEdgeBottom).Weight = xlThick End If End With Next wsh With wsS.Range("B7:N10000") ' Alignements cellules B à N .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom ' Mettre les cellules à "-" .Style = "Comma" .NumberFormat = "_-* #,##0 _€_-;-* #,##0 _€_-;_-* ""-""?? _€_-;_-@_-" ' Mise en page ThisWorkbook.Worksheets("MODELE").Range("A3:M4").Copy For noL = 1 To drL - 7 If .Cells(noL, "B").Value <> "Totalazerty" And .Cells(noL, "B").Value <> "" Then .Rows(noL).PasteSpecial Paste:=xlPasteFormats End If Next noL End With ' Étendre le séparateur de B à N For noL = 7 To drL If wsS.Cells(noL, "A").Borders(xlEdgeBottom).Weight = xlThick Then wsS.Range(wsS.Cells(noL, "A"), wsS.Cells(noL, "N")).Borders(xlEdgeBottom).Weight = xlThick End If Next noL wsS.Range("P10").Activate End Sub

Rajouter une bordure noire dans un tableau par VBA

1 réponse

Discussions similaires