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
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