Sub copier_graph()
ActiveSheet.ChartObjects(1).Delete
Worksheets("Feuil6").ChartObjects("Graph_vitrage").Activate
ActiveChart.ChartArea.Copy
ActiveSheet.Paste Destination:=Worksheets("Feuil2").Range("B183")
ActiveSheet.ChartObjects(1).Name = "Graph_vitrage"
End Sub
TE = Feuil6.ChartsObjects(1).Range.Value
ReDim TR(1 To 100, 1 To 26)
Worksheets("Feuil6").ChartObjects("Graph_vitrage").Activate
ActiveChart.ChartArea.Copy
Set Rng = PlageSuivante(TR, LR)
LR = 5
ActiveSheet.Paste
InitialiserMiseEnPage Feuil1.[B128], 40, 5
Worksheets("Graphique vitrage").ChartObjects("Graphique 1").Activate
ActiveChart.ChartArea.Copy
Feuil1.Select
LR = 1
'TR(1, 1).Select
'Set Rng = PlageSuivante(TR, LR)
'Rng(1, 1).Select
ActiveSheet.Paste
'Destination:=Worksheets("Rapport").Range("B183")
ActiveSheet.ChartObjects(1).Name = "Graphique 1"
Worksheets("Feuil8").ChartObjects("Graphique 2").Copy Destination:=PlageSuivante(TR, LR)
LR = 1
ActiveSheet.Paste
'Destination:=Worksheets("Rapport").Range("B183")
ActiveSheet.ChartObjects(1).Name = "Graphique 2"
Rem. — Outils
TE = Feuil3.ListObjects(1).Range.Value
ReDim TR(1 To UBound(TE, 1) + 5, 1 To 26)
TR(1, 1) = UCase("Liste des outils")
For C = 1 To 4
TR(4, Choose(C, 1, 24, 25, 26)) = Choose(C, "Outil", "position", "taille", "couleur")
Next C
LR = 5
For LE = 1 To UBound(TE, 1)
LR = LR + 1
For C = 1 To 4
TR(LR, Choose(C, 1, 24, 25, 26)) = TE(LE, C)
Next C, LE
Set Rng = PlageSuivante(TR, LR)
rem. — Graphique
ReDim TR(1 To 12, 1 To 26)
Set Rng = PlageSuivante(TR, 12)
Feuil8.ChartObjects("Graphique 2").Copy
Rng(1, 1).PasteSpecial
ReDim TR(1 To 100, 1 To 26)
LE = 2
Set Rng = PlageSuivante(TR, LR)
LTot = Rng.Rows.Count + 1
Range("AC5:BB24").Copy Rng(LTot + 4, 1)
'Rng(1, 1).Resize(18, 27).Paste
Range("BA8:BB11").Copy
Rng(LTot + 7, 25).PasteSpecial xlPasteValues
TerminerMiseEnPage
End Sub
ReDim TR(1 To 100, 1 To 26)
LE = 2
TR = Range("AC3:BB24").Value
Set Rng = PlageSuivante(TR, UBound(TR, 1))
Rng.PasteSpecial xlPasteFormats = PlageSuivante(TR, UBound(TR, 1))
Set Rng = Range("AC3:BB24")
TR = Rng.Value
Rng.Copy
PlageSuivante(TR, UBound(TR, 1)).PasteSpecial xlPasteFormats
TE = Feuil3.ListObjects(1).Range.Value
ReDim TR(1 To 50, 1 To 26)
LE = 1
Do:
TR(1, 1) = UCase("Liste des outils")
LR = 5: For C = 1 To 4
TR(LR, Choose(C, 1, 24, 25, 26)) = Choose(C, "Outil", "position", "taille", "couleur")
Next C
Do: LR = LR + 1
For C = 1 To 4
TR(LR, Choose(C, 1, 24, 25, 26)) = TE(LE, C)
Next C
LE = LE + 1: Loop Until LE > UBound(TE, 1)
Set Rng = PlageSuivante(TR, LR)
LTot = Rng.Rows.Count + 1
With Rng(4, 1).Resize(2, 23)
.MergeCells = True
End With
With Rng(4, 24).Resize(2)
.MergeCells = True
.HorizontalAlignment = xlCenter
End With
With Rng(4, 25).Resize(2)
.MergeCells = True
.HorizontalAlignment = xlCenter
End With
With Rng(4, 26).Resize(2)
.MergeCells = True
.HorizontalAlignment = xlCenter
End With
With Rng.Rows(4).Resize(2)
.Interior.Color = RGB(186, 265, 186)
.BorderAround ColorIndex:=16
End With
With Rng.Rows(4).Resize(LTot - 4)
.VerticalAlignment = xlCenter
End With
With Rng(6, 24).Resize(LTot - 5, 3)
.NumberFormat = "0.00"
.HorizontalAlignment = xlCenter
End With
Rng.Rows(4).Resize(LTot - 4).BorderAround ColorIndex:=16
Rng(6, 25).Resize(LTot - 6, 2).Borders(xlInsideVertical).ColorIndex = 16
Rng(6, 24).Resize(LTot - 6).BorderAround ColorIndex:=16
With Rng(1, 1)
.Font.Bold = True
.Font.Color = RGB(20, 127, 127)
End With
Rng(LTot + 1, 1).Value = "• Position : droit ou plat"
Rng(LTot + 2, 1).Value = "• Taille : en cm"
Rng(LTot + 3, 1).Value = "• couleur: couleur de l'objet"
Loop Until UBound(TE, 1)