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
| Sub Macro1()
'
' Macro1 Macro
'
Dim x As Integer
x = InputBox("saisir le nombre de variété")
'
Dim ligne As Integer
Dim col1 As Integer
col1 = InputBox("saisir le numéro de colonne de la première valeur de calibre")
Dim col2 As Integer
col2 = InputBox("saisir le numéro de colonne de la dernière valeur de calibre")
Dim Legend2 As Range
Dim Variable As Range
Dim Name As String
Dim Source As Range
Dim Fich As String
Fich = "D:\Users\mathias.frontini.FETL\Pictures\Graphique\"
For ligne = 2 To x + 1
Set Variable = Range(Cells(ligne, col1), Cells(ligne, col2))
Set Source = Application.Union(Range(Cells(1, col1), Cells(1, col2)), Range(Cells(ligne, col1), Cells(ligne, col2)))
Set Legend2 = Cells(ligne, 1)
Name = Legend2.Value
ActiveSheet.Shapes.AddChart2(297, xlBarStacked).Select
ActiveChart.SetSourceData Source:=Source
ActiveChart.PlotBy = xlColumns
ActiveChart.ChartColor = 19
ActiveChart.FullSeriesCollection(1).XValues = Legend2
ActiveChart.ChartTitle.Delete
ActiveChart.Export Filename = Fich & Name & ".gif", FilterName = "GIF"
'je devine que le problème vient de la ligne du dessus mais je ne vois pas où
Next
MsgBox ("Penser à ranger les graphiques dans le dossier adéquat")
End Sub |
Partager