Graphique excel

Graphique excel - VB/VBA/VBS - Programmation

Marsh Posté le 08-06-2012 à 11:56:43    

Bonjour à tous,
voici mon programme

Code :
  1. Sub carte()
  2. Dim maplage, produit1, produit2, spc1, spc2, repro1, repro2 As Range
  3. Dim mongraph As Chart
  4. Dim mini, maxi, miniSN, maxiSN As Single
  5. Dim analyseur, produit, titre As String
  6. Dim debut, fin As Date
  7. mini = Application.WorksheetFunction.Min(Range(Cells(2, 3), Cells(2, 10).End(xlDown)))
  8. maxi = Application.WorksheetFunction.Max(Range(Cells(2, 3), Cells(2, 10).End(xlDown)))
  9. miniSN = Application.WorksheetFunction.Min(Range(Cells(2, 2), Cells(2, 2).End(xlDown)))
  10. maxiSN = Application.WorksheetFunction.Max(Range(Cells(2, 2), Cells(2, 2).End(xlDown)))
  11. analyseur = Worksheets("def" ).Cells(12, 2).Value
  12. produit = Worksheets("def" ).Cells(13, 2).Value
  13. debut = Worksheets("def" ).Cells(10, 2).Value
  14. fin = Worksheets("def" ).Cells(11, 2).Value
  15. titre = analyseur & " - " & produit & " ( " & debut & " to " & fin & " )"
  16. Application.ScreenUpdating = False 'désactive mise à jour écran pendant execution
  17. 'selection de la plage de données pour le graph
  18. Set maplage = Worksheets("données" ).Range(Cells(2, 4), Cells(2, 2).End(xlDown))
  19. 'création du graph
  20. Set mongraph = ThisWorkbook.Charts.Add
  21. mongraph.ChartType = xlXYScatterLinesNoMarkers
  22. mongraph.SetSourceData maplage, xlColumns
  23. mongraph.PlotArea.Interior.ColorIndex = xlNone
  24. With mongraph.Axes(xlCategory)
  25.     .HasMajorGridlines = False
  26.     .HasMinorGridlines = False
  27. End With
  28. With mongraph.Axes(xlValue)
  29.     .HasMajorGridlines = False
  30.     .HasMinorGridlines = False
  31. End With
  32. With mongraph.SeriesCollection(1)
  33.     .ChartType = xlXYScatter
  34.     .Name = "Result"
  35.     .MarkerBackgroundColorIndex = 25
  36.     .MarkerForegroundColorIndex = 25
  37. End With
  38. With mongraph.SeriesCollection(2)
  39.     .Name = "EP"
  40.     .Border.ColorIndex = 1
  41. End With
  42. 'ajout des séries de limites et mise en forme
  43. If Worksheets("données" ).Cells(2, 5).Value = "" Then
  44. Else:
  45.     Set produit1 = Range(Worksheets("données" ).Cells(1, 5), Worksheets("données" ).Cells(1, 5).End(xlDown))
  46.     Set produit2 = Range(Worksheets("données" ).Cells(2, 6), Worksheets("données" ).Cells(2, 6).End(xlDown))
  47.     mongraph.SeriesCollection.Add produit1, xlColumns, True
  48.     mongraph.SeriesCollection.Add produit2, xlColumns, False
  49. End If
  50. If Worksheets("données" ).Cells(2, 7).Value = "" Then
  51. Else:
  52.     Set spc1 = Range(Worksheets("données" ).Cells(1, 7), Worksheets("données" ).Cells(1, 7).End(xlDown))
  53.     Set spc2 = Range(Worksheets("données" ).Cells(2, 8), Worksheets("données" ).Cells(2, 8).End(xlDown))
  54.     mongraph.SeriesCollection.Add spc1, xlColumns, True
  55.     mongraph.SeriesCollection.Add spc2, xlColumns, False
  56. End If
  57. If Worksheets("données" ).Cells(2, 9).Value = "" Then
  58. Else:
  59.     Set repro1 = Range(Worksheets("données" ).Cells(1, 9), Worksheets("données" ).Cells(1, 9).End(xlDown))
  60.     Set repro2 = Range(Worksheets("données" ).Cells(2, 10), Worksheets("données" ).Cells(2, 10).End(xlDown))
  61.     mongraph.SeriesCollection.Add repro1, xlColumns, True
  62.     mongraph.SeriesCollection.Add repro2, xlColumns, False
  63. End If
  64. Dim x As Integer
  65. For x = 3 To mongraph.SeriesCollection.Count
  66.     If mongraph.SeriesCollection(x).Name = "product limits" Then
  67.         mongraph.SeriesCollection(x).Border.ColorIndex = 41
  68.         mongraph.SeriesCollection(x).Border.LineStyle = xlDash
  69.         mongraph.SeriesCollection(x + 1).Border.ColorIndex = 41
  70.         mongraph.SeriesCollection(x + 1).Border.LineStyle = xlDash
  71.     ElseIf mongraph.SeriesCollection(x).Name = "SPC limits" Then
  72.         mongraph.SeriesCollection(x).Border.ColorIndex = 50
  73.         mongraph.SeriesCollection(x).Border.Weight = xlMedium
  74.         mongraph.SeriesCollection(x + 1).Border.ColorIndex = 50
  75.         mongraph.SeriesCollection(x + 1).Border.Weight = xlMedium
  76.     ElseIf mongraph.SeriesCollection(x).Name = "method reproducibility" Then
  77.         mongraph.SeriesCollection(x).Border.ColorIndex = 3
  78.         mongraph.SeriesCollection(x + 1).Border.ColorIndex = 3
  79.         mongraph.SeriesCollection(x).Border.Weight = xlMedium
  80.         mongraph.SeriesCollection(x + 1).Border.Weight = xlMedium
  81.    End If
  82. Next x
  83. If mongraph.Legend.LegendEntries.Count = 8 Then
  84.     mongraph.Legend.LegendEntries(8).Delete
  85.     mongraph.Legend.LegendEntries(6).Delete
  86.     mongraph.Legend.LegendEntries(4).Delete
  87. ElseIf mongraph.Legend.LegendEntries.Count = 6 Then
  88.     mongraph.Legend.LegendEntries(6).Delete
  89.     mongraph.Legend.LegendEntries(4).Delete
  90. Else: mongraph.Legend.LegendEntries(4).Delete
  91. End If
  92. mongraph.Axes(xlValue).MinimumScale = mini - 1
  93. mongraph.Axes(xlValue).MaximumScale = maxi + 1
  94. mongraph.Axes(xlValue).MajorUnit = 1
  95. mongraph.Axes(xlCategory).MinimumScale = miniSN - 1
  96. mongraph.Axes(xlCategory).MaximumScale = maxiSN + 1
  97. mongraph.Axes(xlCategory).TickLabels.NumberFormat = "0"
  98. mongraph.Axes(xlCategory).HasTitle = True
  99. mongraph.Axes(xlCategory).AxisTitle.Caption = "serial number"
  100. mongraph.HasTitle = True
  101. mongraph.ChartTitle.Text = titre
  102. Application.ScreenUpdating = True
  103. 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
Reply

Marsh Posté le 08-06-2012 à 11:56:43   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed