Microsoft 365 Bordure impression

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
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: 63
  • Capture.PNG
    Capture.PNG
    21 KB · Affichages: 51
Trier par date Trier par votes
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
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

Vote positif 0 Vote négatif
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
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
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

L
  • Résolu(e)
XL 2019 VBA problème zone d'impression
Réponses
2
Affichages
599
Lionel69890
L
M
  • Résolu(e)
Microsoft 365 Gestion numéros de pages du classeur dans une cellule
2
Réponses
16
Affichages
2 K
sousou
sousou
V
  • Question Question
XL 2019 Définir des zones d'impression à partir de cellules fixes en VBA
Réponses
1
Affichages
1 K
GALOUGALOU
GALOUGALOU
F
  • Question Question
XL 2019 Problème Macro Excel vers internet
Réponses
11
Affichages
1 K
Staple1600
Staple1600
Q
  • Question Question
XL 2013 Définir ma zone d'impression avec un nombre de ligne qui n'est pas fixe
Réponses
6
Affichages
1 K
kiki29
kiki29
H
  • Question Question
Microsoft 365 Saut de ligne pour impression VBA
Réponses
3
Affichages
1 K
Harlem_2021
H
J
  • Question Question
XL 2019 Impression en PDF d'une page par cellule
Réponses
0
Affichages
808
Jacques25bis
J
K
  • Question Question
XL 2019 Extraction données avec filtre d'un fichier .txt sur Excel & créer nouveau fichier .txt
Réponses
1
Affichages
3 K
Hasco
Hasco
C
  • Question Question
XL 2013 Macro VBA appliquer une formule somme.si.ens à un tableau et ensuite une recherche mutli critere
Réponses
12
Affichages
2 K
Dranreb
Dranreb
M
  • Question Question
Centrer automatiquement un rectangle créé avec des bordures avec VBA
Réponses
7
Affichages
2 K
Matta
M
B
  • Question Question
XL 2013 [ RESOLU] Suppression Bordure Rouge VBA
Réponses
2
Affichages
3 K
BENAM69
B
M
  • Résolu(e)
Supprimer une ligne d'un tableau selon la valeur d'une cellule sous VBA (sans supprimer les lignes au dessus)
Réponses
14
Affichages
9 K
MaDesn
M
D
  • Question Question
Microsoft 365 Problème en tête dans l'impression de la base de données
Réponses
2
Affichages
1 K
dubarre
D
H
  • Question Question
XL 2019 macro pour copier un tableau avec mot cle de word vers excel et dispatcher données sur plusieurs cellules
Réponses
0
Affichages
1 K
hajar1403
H
Mirguy23
  • Question Question
XL 2010 Macro Synthèse Excel Vba
Réponses
0
Affichages
1 K
Mirguy23
Mirguy23
B
  • Question Question
XL 2013 [RESOLU] Excel VBA - Incompatibilité de Type
Réponses
2
Affichages
1 K
BENAM69
B
P
  • Question Question
XL 2010 Variable TextBox dans une boucle d'un autre module
Réponses
1
Affichages
1 K
vgendron
vgendron
grisan29
  • Question Question
XL 2013 (merci a si...)(RESOLU)remonter ligne basse sans la bordure basse
2 3
Réponses
40
Affichages
4 K
grisan29
grisan29
R
  • Question Question
macro impression sur 1 seule page avec des plages de cellules multiples
Réponses
2
Affichages
3 K
rh.finances
R
T
  • Question Question
classeur excel sans macro VBA
Réponses
9
Affichages
1 K
totony59
T
Retour