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