effacer le contenu des cellules après impression

doudou080

XLDnaute Nouveau
bonjour a tous
je voulais ajouter ClearContents pour effacer le contenu des cellules après impression
je ne trouve pas ou ca bug
qui peux m'aider svp
cordialement votre

Sub Macro1()
'
' Touche de raccourci du clavier: Ctrl+a

'
Sheets("plan chargement").Select
Range("A2").Select
Selection.Copy
Sheets("gestion des supports").Select
Range("F4:G4").Select
ActiveSheet.Paste
Sheets("plan chargement").Select
Range("L2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("gestion des supports").Select
Range("F7:G7").Select
ActiveSheet.Paste
Sheets("plan chargement").Select
Range("I2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("gestion des supports").Select
Range("D20").Select
ActiveSheet.Paste
Sheets("plan chargement").Select
Range("J2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("gestion des supports").Select
Range("E20:F20").Select
ActiveSheet.Paste
Range("G20").Select
ActiveWindow.SmallScroll Down:=9
Range("D20:F20").Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("D20").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("F18").Select
Dim DerLig As Long
With Worksheets("plan chargement") 'A adapter
DerLig = .Range("A1").End(xlDown).Row
MsgBox "Numéro de la dernière ligne : " & DerLig
End With
With Sheets("gestion des supports")
For i = 2 To DerLig
.Range("G1") = Sheets("plan chargement").Range("L" & i)
.Range("F4:G4") = Sheets("plan chargement").Range("A" & i)
.Range("F7:G7") = Sheets("plan chargement").Range("L" & i)
.Range("D20") = Sheets("plan chargement").Range("I" & i)
.Range("E20:F20") = Sheets("plan chargement").Range("J" & i)
.PrintOut copies:=1, ClearContents

Next i
End With
End Sub
 

doudou080

XLDnaute Nouveau
ca y est je m'en suis sortie.

With Sheets("gestion des supports")
For i = 2 To DerLig
.Range("G1") = Sheets("plan chargement").Range("L" & i)
.Range("F4:G4") = Sheets("plan chargement").Range("A" & i)
.Range("F7:G7") = Sheets("plan chargement").Range("L" & i)
.Range("D20") = Sheets("plan chargement").Range("I" & i)
.Range("E20:F20") = Sheets("plan chargement").Range("J" & i)
.PrintOut copies:=1 'impression 1 copie
Range("F18,G1,F4:G4,F7:G7,D20,E20:G20").Select
Range("E20").Activate
Selection.ClearContents
Next i
End With

par contre j'ai fait une autre demande sur un autre problème.
comment associer deux modules a un seul bouton

et la je vais avoir besoin d'aide.
en vous remerciant d'avance
cordialement
 

Victor21

XLDnaute Barbatruc
Re,

bonjour
c'est pour quel sujet ?
En général, j'interviens dans le sujet traité, ici donc l'effacement des données après l'envoi vers l'imprimante sans contrôle de l'impression.
Quand pensez-vous ?
Parfois :)
Blague à part, bille en VBA, je ne saurais vous conseiller utilement sur le code, mais il me semble que la réponse figure dans l'autre fil (Robert, je crois).
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 948
Membres
101 850
dernier inscrit
Danigra