Microsoft 365 Bordure impression

C

clairmrs

XLDnaute Nouveau
Bonjour à tous,

Je vous contacte aujourd'hui car j'ai crée une macro sous excel qui me permet de mettre en page rapidement mes documents. Des bordures se dessinent sur les extrémités du tableau mais elle descendent jusqu'en bas de la feuille. Cela ne me pose pas de problème car mon fichier est destiné à l'impression. Je rencontre un problème avec ma zone d'impression, car il reste des bordures verticales en bas du tableau que ne dois supprimer manuellement. J'ai donc essayé de redéfinir ma zone d'impression une ligne au dessus mais du coup ma dernière bordure horizontale n’apparaît pas. Ci joint des annexes avec les bordures en jaunes à supprimer. Quelqu'un à une solution à ce problème ?
Je vous remercie de votre aide.
Dans l'attente de vous lire
 

Pièces jointes

  • tableau.PNG
    tableau.PNG
    34.3 KB · Affichages: 58
  • Capture.PNG
    Capture.PNG
    21 KB · Affichages: 46
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Bonjour clairems, le fil, le forum

Je te laisse tester sur ton fichier
VB: 
Sub Test()
Dim rng As Range
Set rng = Range(ActiveSheet.PageSetup.PrintArea)
'
'-> ton code VBA d'origine pour les  bordures
'(moins le code qui bordure le contour de ton tableau
'
'bordurage du Contour
rng.BorderAround 1, xlMedium
End Sub
 
Vote positif 0 Vote négatif
C

clairmrs

XLDnaute Nouveau
Staple1600 à dit:
Bonjour clairems, le fil, le forum
VB: 
Sub CLAIRE()

'Mettre en page les en-tête et pied de page
With ActiveSheet.PageSetup
    'en-tête de page
    .LeftHeader = Range("B1").Value & Chr(10) & "Décomposition du Prix Global et Forfaitaire" 'Nom de l'affaire + saut de ligne + DPGF
    .RightHeader = "&A" & Chr(10) & "Page " & "&P/&N" 'Numéro et nom de lot + saut de ligne + numéro de page/ nbr de page
    ' pied de page
    .CenterFooter = "Etabli par ESPINAL INGENIERIE, le " & "&D" & Chr(10) & "Phase DCE - Indice A"  ' Auteur + date + saute de ligne + phase
End With

'Supprimer la ligne 1
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    
'Supprimer la ligne 3
    Rows("3:3").Select
    Selection.Delete Shift:=xlUp
    
'Remplacer le texte de la cellule B3 par D.P.G.F
Range("B3").Value = "D.P.G.F"
Range("B3").Font.Size = 12

'Supprimer la ligne 4
    Rows("4:4").Select
    Selection.Delete Shift:=xlUp
    
' Insérer deux lignes
    Rows("4:4").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("6:6").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

'Agrandir taille colonne
    Columns("A:A").ColumnWidth = 12.35
    Columns("B:B").ColumnWidth = 65.43
    Columns("C:C").ColumnWidth = 5.71
    Columns("D:D").ColumnWidth = 12.57
    Columns("E:E").ColumnWidth = 10.57
    Columns("F:F").ColumnWidth = 14.14
    
    
'Agrandir taille première ligne
    Rows("1:1").RowHeight = 39
    
Columns("A:A").Select
    Selection.ColumnWidth = 12.7
    
'Ajouter "Référence" et "désignation" dans les colonnes A et B
ActiveCell.FormulaR1C1 = "Référence"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Désignation"
    Range("A1").Select
    
  
'Centrer les titres au milieu de la case
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("C1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("D1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("E1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("F1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
'Rajouter bordure colonne A
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone

'Passer les colonnes C,D,E et F en taille 8 et police Arial
Range("C:F").Font.Size = 8
Range("C:F").Font.Name = "Arial"


'Passer la ligne 1 en taille 10, Arial
Rows("1").Font.Size = 10
Rows("1").Font.Name = "Arial"


' Mettre tout ce qui est en calibri, gras taille 11 --> en arial, gras taille 12
     With Application.FindFormat.Font
        .Name = "Calibri"
        .FontStyle = "Gras"
        .Size = 11
        .Superscript = False
        .Subscript = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Application.ReplaceFormat.Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 12
        .Subscript = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Cells.Replace What:="", Replacement:="", LookAt:=xlWhole, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
    
'Chercher la dernière ligne du tableau
    Cells.Find(What:="Montant TTC", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Select
    ActiveCell.RowHeight = 25
    
 'Remplacer par "T.V.A au taux de 20,00%" en Arial taille 12, gras
ActiveCell.Offset(-1, 0).Select
    ActiveCell.FormulaR1C1 = "T.V.A au taux de 20,00%"
    
'Modifier formule TVA + rajouter bordure
    ActiveCell.Offset(0, 4).Select
    With Selection
             .FormulaR1C1 = "=(R[-1]C*20)/100"
             .Borders(xlEdgeBottom).Weight = xlMedium   ' bordure bass
End With

'Dessiner bordure bas du tableau
ActiveCell.Offset(2, 0).Select
    With Selection
        .Borders(xlEdgeTop).Weight = xlMedium   ' bordure haute
End With

ActiveCell.Offset(0, -1).Select
With Selection
        .Borders(xlEdgeTop).Weight = xlMedium   'bordure haute
End With

ActiveCell.Offset(0, -1).Select
With Selection
        .Borders(xlEdgeTop).Weight = xlMedium   'bordure haute
End With

ActiveCell.Offset(0, -1).Select
With Selection
        .Borders(xlEdgeTop).Weight = xlMedium  'bordure haute
End With

ActiveCell.Offset(0, -1).Select
With Selection
        .Borders(xlEdgeTop).Weight = xlMedium 'bordure haute
End With

ActiveCell.Offset(0, -1).Select
With Selection
        .Borders(xlEdgeTop).Weight = xlMedium   'bordure haute
End With


'Dessiner une bordure sous les titres
    Range("A1:F1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = -16777216
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -16777216
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = -16777216
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
'Bordure colonnes A et F
    Columns("F:F").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    
    Columns("A:A").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
      
'Chercher la ligne "Total descriptopn et localisation des ouvrages
    Cells.Find(What:="Montant TTC", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(-6, 0).Select
        ActiveCell.FormulaR1C1 = "Total D.P.G.F"

End Sub

Je te laisse tester sur ton fichier
VB: 
Sub Test()
Dim rng As Range
Set rng = Range(ActiveSheet.PageSetup.PrintArea)
'
'-> ton code VBA d'origine pour les  bordures
'(moins le code qui bordure le contour de ton tableau
'
'bordurage du Contour
rng.BorderAround 1, xlMedium
End Sub
Cliquez pour agrandir...


Bonjour,
Je vous remercie d'avoir pris le temps de me répondre et d'avoir cherché une solution à mon problème.
En revanche, je ne comprends pas votre code ??? Veuillez m'excuser...
Je me permets de vous transmettre les fichiers dont je parle (code VBA et fichier excel sur laquelle la macro doit s'appliquer)
Bonne journée
Cordialement
 

Pièces jointes

  • TEST - Lot N°01 MENUISERIES EXTERIEURES OCCULTATIONS.xlsx
    14.2 KB · Affichages: 4
Vote positif 0 Vote négatif
C

clairmrs

XLDnaute Nouveau
Staple1600 à dit:
Bonsoir

Est-ce que tu as cherché à testé mon code?
Il est simple à mettre en oeuvre, il suffit de lire les commentaires en vert.
NB: Il faut qu'une zone d'impression ait été définie pour cela fonctionne correctement.
Cliquez pour agrandir...


C'est génial merci beaucoup ! Je n'ai plus ses bordures qu'il fallait gommer à chaque fois, ducoup il faut définir la zone d'impression sur chaque document ou je peux également automatiser cela ?
Cdt
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir

Bah définis ta zone d'impression par macro.
(Et pour ce faire utilise l'enregistreur de macros ;))
VB: 
Sub Exemple()
Dim S1600 As Range 'pour test
Set S1600 = Range("A1:C21") 'pour test
S1600 = "=ADDRESS(ROW(),COLUMN(),4)" 'pour test
ActiveSheet.PageSetup.PrintArea = S1600.Address ' la ligne à  retenir
ActiveSheet.PrintPreview 'pour test
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

E
  • Résolu(e)
Microsoft 365 Zone d'impression
Réponses
6
Affichages
737
AtTheOne
AtTheOne
D
  • Question
XL 2016 Une Zone de Liste pour plusieurs cellules.
Réponses
7
Affichages
148
duduche62
D
R
  • Question
Microsoft 365 VBA Excel PowerPoint
Réponses
5
Affichages
185
Rem6610
R
G
  • Résolu(e)
XL 2021 Problème d'impression
Réponses
2
Affichages
407
gui22
G
M
  • Résolu(e)
Microsoft 365 Gestion numéros de pages du classeur dans une cellule
2
Réponses
16
Affichages
1 K
sousou
sousou
chris6999
  • Question
Microsoft 365 Macro pour redimensionner une zone nommée
Réponses
12
Affichages
262
Staple1600
Staple1600
L
  • Résolu(e)
XL 2019 Export to pdf / Problème Zone d'impression
Réponses
7
Affichages
734
Compte Supprimé 979
C
L
  • Résolu(e)
XL 2019 VBA problème zone d'impression
Réponses
2
Affichages
469
Lionel69890
L
L
  • Résolu(e)
XL 2016 enregistrer une zone d'impression en pdf
Réponses
7
Affichages
2 K
Linda42
L
G
  • Question
XL 2016 outil de suivi excel
Réponses
5
Affichages
433
Geyka
G

Membres actuellement en ligne

9 membres et 86 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 499
Messages
2 110 247
Membres
110 711
dernier inscrit
chmessi