nadeson | Bonjour à tous,
voici mon programme
Code :
- Sub carte()
- Dim maplage, produit1, produit2, spc1, spc2, repro1, repro2 As Range
- Dim mongraph As Chart
- Dim mini, maxi, miniSN, maxiSN As Single
- Dim analyseur, produit, titre As String
- Dim debut, fin As Date
- mini = Application.WorksheetFunction.Min(Range(Cells(2, 3), Cells(2, 10).End(xlDown)))
- maxi = Application.WorksheetFunction.Max(Range(Cells(2, 3), Cells(2, 10).End(xlDown)))
- miniSN = Application.WorksheetFunction.Min(Range(Cells(2, 2), Cells(2, 2).End(xlDown)))
- maxiSN = Application.WorksheetFunction.Max(Range(Cells(2, 2), Cells(2, 2).End(xlDown)))
- analyseur = Worksheets("def" ).Cells(12, 2).Value
- produit = Worksheets("def" ).Cells(13, 2).Value
- debut = Worksheets("def" ).Cells(10, 2).Value
- fin = Worksheets("def" ).Cells(11, 2).Value
- titre = analyseur & " - " & produit & " ( " & debut & " to " & fin & " )"
- Application.ScreenUpdating = False 'désactive mise à jour écran pendant execution
- 'selection de la plage de données pour le graph
- Set maplage = Worksheets("données" ).Range(Cells(2, 4), Cells(2, 2).End(xlDown))
- 'création du graph
- Set mongraph = ThisWorkbook.Charts.Add
- mongraph.ChartType = xlXYScatterLinesNoMarkers
- mongraph.SetSourceData maplage, xlColumns
- mongraph.PlotArea.Interior.ColorIndex = xlNone
- With mongraph.Axes(xlCategory)
- .HasMajorGridlines = False
- .HasMinorGridlines = False
- End With
- With mongraph.Axes(xlValue)
- .HasMajorGridlines = False
- .HasMinorGridlines = False
- End With
- With mongraph.SeriesCollection(1)
- .ChartType = xlXYScatter
- .Name = "Result"
- .MarkerBackgroundColorIndex = 25
- .MarkerForegroundColorIndex = 25
- End With
- With mongraph.SeriesCollection(2)
- .Name = "EP"
- .Border.ColorIndex = 1
- End With
- 'ajout des séries de limites et mise en forme
- If Worksheets("données" ).Cells(2, 5).Value = "" Then
- Else:
- Set produit1 = Range(Worksheets("données" ).Cells(1, 5), Worksheets("données" ).Cells(1, 5).End(xlDown))
- Set produit2 = Range(Worksheets("données" ).Cells(2, 6), Worksheets("données" ).Cells(2, 6).End(xlDown))
- mongraph.SeriesCollection.Add produit1, xlColumns, True
- mongraph.SeriesCollection.Add produit2, xlColumns, False
- End If
- If Worksheets("données" ).Cells(2, 7).Value = "" Then
- Else:
- Set spc1 = Range(Worksheets("données" ).Cells(1, 7), Worksheets("données" ).Cells(1, 7).End(xlDown))
- Set spc2 = Range(Worksheets("données" ).Cells(2, 8), Worksheets("données" ).Cells(2, 8).End(xlDown))
- mongraph.SeriesCollection.Add spc1, xlColumns, True
- mongraph.SeriesCollection.Add spc2, xlColumns, False
- End If
- If Worksheets("données" ).Cells(2, 9).Value = "" Then
- Else:
- Set repro1 = Range(Worksheets("données" ).Cells(1, 9), Worksheets("données" ).Cells(1, 9).End(xlDown))
- Set repro2 = Range(Worksheets("données" ).Cells(2, 10), Worksheets("données" ).Cells(2, 10).End(xlDown))
- mongraph.SeriesCollection.Add repro1, xlColumns, True
- mongraph.SeriesCollection.Add repro2, xlColumns, False
- End If
- Dim x As Integer
- For x = 3 To mongraph.SeriesCollection.Count
- If mongraph.SeriesCollection(x).Name = "product limits" Then
- mongraph.SeriesCollection(x).Border.ColorIndex = 41
- mongraph.SeriesCollection(x).Border.LineStyle = xlDash
- mongraph.SeriesCollection(x + 1).Border.ColorIndex = 41
- mongraph.SeriesCollection(x + 1).Border.LineStyle = xlDash
- ElseIf mongraph.SeriesCollection(x).Name = "SPC limits" Then
- mongraph.SeriesCollection(x).Border.ColorIndex = 50
- mongraph.SeriesCollection(x).Border.Weight = xlMedium
- mongraph.SeriesCollection(x + 1).Border.ColorIndex = 50
- mongraph.SeriesCollection(x + 1).Border.Weight = xlMedium
- ElseIf mongraph.SeriesCollection(x).Name = "method reproducibility" Then
- mongraph.SeriesCollection(x).Border.ColorIndex = 3
- mongraph.SeriesCollection(x + 1).Border.ColorIndex = 3
- mongraph.SeriesCollection(x).Border.Weight = xlMedium
- mongraph.SeriesCollection(x + 1).Border.Weight = xlMedium
- End If
- Next x
- If mongraph.Legend.LegendEntries.Count = 8 Then
- mongraph.Legend.LegendEntries(8).Delete
- mongraph.Legend.LegendEntries(6).Delete
- mongraph.Legend.LegendEntries(4).Delete
- ElseIf mongraph.Legend.LegendEntries.Count = 6 Then
- mongraph.Legend.LegendEntries(6).Delete
- mongraph.Legend.LegendEntries(4).Delete
- Else: mongraph.Legend.LegendEntries(4).Delete
- End If
- mongraph.Axes(xlValue).MinimumScale = mini - 1
- mongraph.Axes(xlValue).MaximumScale = maxi + 1
- mongraph.Axes(xlValue).MajorUnit = 1
- mongraph.Axes(xlCategory).MinimumScale = miniSN - 1
- mongraph.Axes(xlCategory).MaximumScale = maxiSN + 1
- mongraph.Axes(xlCategory).TickLabels.NumberFormat = "0"
- mongraph.Axes(xlCategory).HasTitle = True
- mongraph.Axes(xlCategory).AxisTitle.Caption = "serial number"
- mongraph.HasTitle = True
- mongraph.ChartTitle.Text = titre
- Application.ScreenUpdating = True
- End Sub
|
Il marche nickel mais le problème est que y'a certaine chose qui ne s'affiche pas sur le graphique: pour "SPC limits" les points doivent etre relié en vert , "method reproducibility" en rouge et "product limits" en pointillé bleu mais cela n'est pas le cas. Je ne comprends pas pourquoi
PS: j'utilise excel 2010
Message édité par nadeson le 08-06-2012 à 12:26:04
|
