1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
| Dim feuille As Worksheet
Dim plage As Range
' DECLARATION tableau avec tous les noms des feuilles
Set feuilles = Sheets(Array("AIGUEPERSE", "ALBIGNY-SUR-SAONE", "ALIX", "AMPLEPUIS", "AMPUIS", "ANSE", "ARNAS", "AVEIZE", "AVENAS", "BAGNOLS", "BEAUJEU", "BELLEVILLE", "BESSENAY", "BLACÉ", "BOURG DE THIZY", "BRIGNAIS", "BRINDAS", "BRULLIOLES", "BRUSSIEU", "BULLY", "CAILLOUX-SUR-FONTAINES", "CHAMBOST-LONGESSAIGNE", "CHAMELET", "CHAMPAGNE-AU-MONT-D'OR", "CHAPONNAY", "CHAPONOST", "CHARBONNIERES-LES-BAINS", "CHARENTAY", "CHARLY", "CHARNAY", "CHASSAGNY", "CHASSELAY", "CHASSIEU", "CHATILLON D'AZERGUES - CHESSY", "CHAUSSAN", "CHAZAY D'AZERGUES", "CHEVINAY", "CHIROUBLES", "CLAVEISOLLES", "COGNY", "COISE", "COLLONGES-AU-MONT-D'OR", "COLOMBIER-SAUGNIEU", "COMMUNAY", "CONDRIEU", "CORBAS", "CORCELLES-EN-BEAUJOLAIS", "COURS-LA-VILLE", "COURZIEU", "COUZON-AU-MONT-D'OR", "CRAPONNE", "CUBLIZE", "CURIS-AU-MONT-D'OR", "DARDILLY", "DENICÉ", "DOMMARTIN", "DUERNE", "ECHALAS", "EVEUX", "FEYZIN", "FLEURIE", "FLEURIEU-SUR-SAONE", "FLEURIEUX-SUR-L'ARBRESLE", "FONTAINES-SUR-SAONE", "FRANCHEVILLE"))
For Each feuille In feuilles
' DECLARATION plage des données source
Set plage = feuille.Range("AO1:AO8")
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=plage, PlotBy _
:=xlColumns
ActiveChart.SeriesCollection(1).XValues = feuille.Range("A2:A8")
ActiveChart.SeriesCollection(1).Name = feuille.Range("AO1")
' MISE EN FORME localisation du graphique dans la feuille
ActiveChart.Location Where:=xlLocationAsObject, Name:=feuille.Name
' MISE EN FORME titre légende
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Evolution des prêts MD Vidéo"
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
.HasLegend = False
End With
ActiveChart.HasLegend = False
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
' MISE EN FORME changement de couleur
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' vert relais
.ColorIndex = 43
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(2).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' vert relais
.ColorIndex = 43
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(3).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' vert relais
.ColorIndex = 43
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(4).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' vert relais
.ColorIndex = 43
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(5).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' vert relais
.ColorIndex = 43
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(6).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' bleu réseau
.ColorIndex = 41
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(7).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' jaune md
.ColorIndex = 44
.Pattern = xlSolid
End With
' MISE EN FORME renommer le graphique pour pouvoir le placer
ActiveSheet.Shapes("Graphique 19").Name = "PMDVID"
With ActiveSheet.Shapes("PMDVID")
.Left = Range("B370").Left
.Top = Range("B370").Top
End With
' FORMATAGE ne pas déplacer et dimensionner avec les cellules
With ActiveSheet.DrawingObjects("PMDVID")
.Placement = xlFreeFloating
.PrintObject = True
End With
ActiveSheet.DrawingObjects("PMDVID").Locked = True
Next
End Sub |
Partager