Macro création graphique

[Redemption]

Bonjour à tous.

C'est mon premier post sur ce forum, je vais donc essayer d'être le plus clair possible.
Je travail sur Excel 2003 SP3.
Je cherche à créer une macro en vba, qui créerait automatiquement un graphique de type camembert sur la page active.
Sur ce graphique je souhaiterais voir 3 tranches à chaque fois :
celle qui correspond au total des matières.
celle qui correspond au total des commandes.
celle qui correspond au total de la main d'œuvre.

C'est une autre macro qui met en forme chaque tableau de données. Il y a un tableau par page, et les informations à reprendre dans le graphique ne sont pas forcement toujours à la même ligne. Cela dépend du nombre de ligne de matière, commande, etc.

Je joins bien entendu un exemple de tableau à partir duquel je veux créer un graphique.

J'ai déjà essayer de créer une macro via l'enregistreur de macro, mais je n'arrive pas à rendre cette macro "flexible", pour qu'elle s'adapte à chaque tableau. C'est à dire qu'elle construise bien les graphiques avec les données de sous-totaux (matière, commande, MO) qui se trouve dans des cellules différentes pour chaque tableau.

Merci d'avance pour votre aide 🙂

 

[PMO2]

Re : Macro création graphique

Bonjour,

Une piste avec le code suivant. Je me suis basé sur la feuille 020592 de votre exemple.

Code à copier dans un module standard

Sub MakeGraph()
Dim S As Worksheet
Dim R As Range
Dim C As Range
Dim C2 As Range
Dim A$
Dim B$
Dim CH As Chart
On Error GoTo Erreur
Set S = ActiveSheet
Set R = S.Cells.SpecialCells(xlCellTypeFormulas)
For Each C In R
  If InStr(1, C.Formula, "SUBTOTAL") Then
    If Len(C.Offset(0, 2)) > Len("Total") Then
      A$ = A$ & "'" & S.Name & "'!" & _
          C.Address(True, True, xlR1C1) & ","
      Set C2 = C.Offset(0, 2)
      B$ = B$ & "'" & S.Name & "'!" & _
          C2.Address(True, True, xlR1C1) & ","
    End If
  End If
Next C
A$ = "=(" & Mid(A$, 1, Len(A$) - 1) & ")"
B$ = "=(" & Mid(B$, 1, Len(B$) - 1) & ")"
Set CH = Charts.Add
With CH
  .ChartType = xlPie
  .SeriesCollection.NewSeries
  With .SeriesCollection(1)
    .Values = A$
    .XValues = B$
    .ApplyDataLabels AutoText:=True, _
      ShowCategoryName:=True, _
      ShowPercentage:=True, _
      LegendKey:=True
  End With
  .Legend.Delete
  .Location Where:=xlLocationAsObject, Name:=S.Name
End With
With ActiveChart
  With .PlotArea
    .Border.LineStyle = xlNone
    .Interior.ColorIndex = xlNone
  End With
  .Deselect
End With
Erreur:
If Err <> 0 Then MsgBox "Erreur " & Err.Number & vbCrLf _
  & Err.Description & vbCrLf & "Arrêt sur la feuille " & ActiveSheet.Name
End Sub

Cordialement.

PMO
Patrick Morange

 

[Redemption]

Re : Macro création graphique

Bonjour Patrick,

Et surtout merci ! Votre code fonctionne parfaitement. Je l'ai intégré à un autre module sans souci.

Je n'ai pas encore eu le temps de regarder le code en détail mais je prendrais le temps de le faire. J'aime bien savoir comment ça marche 🙂 .

Merci encore.