Bonjour,
Comment simplifier ce code où je mets des lignes autour des cellules et que j'imprime la feuille ?
Application.ScreenUpdating = False
Sheets("Feuil2").Select
'ET101A
Range("b1").Select
ActiveCell.FormulaR1C1 = "ET101A"
Range("A9:G22").Select
Selection.ClearContents
Sheets("Feuil3").Select
Range("a3").Select
Range(Selection, ActiveCell.Offset(0, 1)).Select
Do Until ActiveCell = ""
Selection.Copy
Sheets("Feuil2").Select
Range("A9").Select
Retour101a:
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
GoTo Retour101a
Else
Selection.PasteSpecial
End If
Sheets("Feuil3").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, ActiveCell.Offset(0, 1)).Select
Loop
Sheets("Feuil2").Select
Range("A9:h22").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
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
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
'ET101B
Range("b1").Select
ActiveCell.FormulaR1C1 = "ET101B"
Range("A9:G22").Select
Selection.ClearContents
Sheets("Feuil3").Select
Range("b3").Select
Range(Selection, ActiveCell.Offset(0, 1)).Select
Do Until ActiveCell = ""
Selection.Copy
Sheets("Feuil2").Select
Range("A9").Select
Retour101b:
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
GoTo Retour101b
Else
Selection.PasteSpecial
End If
Sheets("Feuil3").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, ActiveCell.Offset(0, 1)).Select
Loop
Sheets("Feuil2").Select
Range("A9:h22").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
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
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
Merci
Comment simplifier ce code où je mets des lignes autour des cellules et que j'imprime la feuille ?
Application.ScreenUpdating = False
Sheets("Feuil2").Select
'ET101A
Range("b1").Select
ActiveCell.FormulaR1C1 = "ET101A"
Range("A9:G22").Select
Selection.ClearContents
Sheets("Feuil3").Select
Range("a3").Select
Range(Selection, ActiveCell.Offset(0, 1)).Select
Do Until ActiveCell = ""
Selection.Copy
Sheets("Feuil2").Select
Range("A9").Select
Retour101a:
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
GoTo Retour101a
Else
Selection.PasteSpecial
End If
Sheets("Feuil3").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, ActiveCell.Offset(0, 1)).Select
Loop
Sheets("Feuil2").Select
Range("A9:h22").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
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
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
'ET101B
Range("b1").Select
ActiveCell.FormulaR1C1 = "ET101B"
Range("A9:G22").Select
Selection.ClearContents
Sheets("Feuil3").Select
Range("b3").Select
Range(Selection, ActiveCell.Offset(0, 1)).Select
Do Until ActiveCell = ""
Selection.Copy
Sheets("Feuil2").Select
Range("A9").Select
Retour101b:
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
GoTo Retour101b
Else
Selection.PasteSpecial
End If
Sheets("Feuil3").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, ActiveCell.Offset(0, 1)).Select
Loop
Sheets("Feuil2").Select
Range("A9:h22").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
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
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
Merci
Dernière édition: