Philippe Tulliez

AVANT-PROPOS

J'ai été confronté dernièrement à un travail d'élaboration de plusieurs graphiques et en appliquant des étiquettes de données à une série d'un histogramme, je me suis rendu compte qu'il n'y avait d'autres choix que de refaire le même travail pour les autres séries du même graphique.
Persuadé que j'étais sans doute passé à côté d'une option cachée, j'ai ouvert sur le forum Excel, une discussion titrée Graphique - Appliquer le même format des étiquettes de données à toutes les séries
Hélas et au vu des réponses apportées par d'autres contributeurs, il a fallu se rendre à l'évidence qu'il fallait passer par le VBA.

C'est le résultat de ce travail que je publie dans ce billet.

L'EXEMPLE

Pour l'exemple, nous partons d'un graphique en histogramme 2-D, basé sur un tableau croisé dynamique (voir illustration ci-dessous)

Les données sources


Les étapes

La procédure copie les propriétés de la collection DataLabels d'une série sélectionnées sur les autres.
Il faut donc cliquer sur une étiquette de la série pour pouvoir sélectionner l'ensemble des étiquettes de la série comme illustré ci-dessous (Attention, ne pas cliquer deux fois sinon seule l'étiquette sur laquelle on se trouve sera sélectionnée)
Ensuite, il suffit de lancer la procédure nommée PutDataLabelsProperties

Sélection de la série


Résultat après


CODE DE LA PROCEDURE

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Sub PutDataLabelsProperties()
  ' Reste à faire le remplissage de format
  ' Procédure répartissant sur l'ensemble des séries les mêmes propriétés que la série sélectionnée
  '   Le traitement est effectué sur :
  '   - les séries non sélectionnées
  '   - ayant le même type de graphique que la série sélectionnée (par exemple le cas de l'axe secondaire)
  '   sont également traités les propriétés Font Bold et Italic ainsi que les couleurs des caractères (pas le remplissage)
  '
  ' Philippe Tulliez (www.magicoffice.be)
  ' version : 1.1
  ' Déclaration variables
  Dim oChart As Chart
  Dim oSerie As Series
  Dim oSerieA As Series           ' La série sélectionnée
  Dim oDataLabelsA As DataLabels  ' Les étiquettes de la série sélectionnée
  Dim oDataLabels As DataLabels
  Dim oTextFrame As TextFrame2
  Dim HasFontItalic As Boolean
  Dim HasFontBold As Boolean
  Dim HasFontFillColor As Boolean
  Dim FontFillColor As Long
  ' Vérifie si les étiquettes d'une série sont sélectionnées
  If TypeName(Selection) = "DataLabels" Then
     '
     Set oChart = ActiveChart
     Set oSerieA = Selection.Parent
     Set oDataLabelsA = oChart.FullSeriesCollection(oSerieA.Name).DataLabels
     '
     With oDataLabelsA
       With .Format
         With .TextFrame2.TextRange.Font
           HasFontBold = .Bold: HasFontItalic = .Italic
            ' Couleur de police
           With .Fill  ' Remplissage du format
            HasFontFillColor = .Visible
            FontFillColor = .ForeColor.RGB
           End With
         End With
       End With
     End With
     '
     For Each oSerie In oChart.SeriesCollection
       If oSerie.Name <> oSerieA.Name And oSerie.ChartType = oSerieA.ChartType Then
          If Not oSerie.HasDataLabels Then
             oChart.FullSeriesCollection(oSerie.Name).ApplyDataLabels
          End If
          '
          Set oDataLabels = oChart.FullSeriesCollection(oSerie.Name).DataLabels
          With oDataLabels
           With .Format
             With .TextFrame2.TextRange.Font
             .Bold = HasFontBold: .Italic = HasFontItalic
              With .Fill
              .Visible = HasFontFillColor: .ForeColor.RGB = FontFillColor
              End With
             End With
           End With
          .Position = oDataLabelsA.Position
          .Separator = oDataLabelsA.Separator
          .NumberFormat = oDataLabelsA.NumberFormat
          .NumberFormatLinked = oDataLabelsA.NumberFormatLinked
          .ShowValue = oDataLabelsA.ShowValue
          .ShowSeriesName = oDataLabelsA.ShowSeriesName
          .ShowLegendKey = oDataLabelsA.ShowLegendKey
          .ShowCategoryName = oDataLabelsA.ShowCategoryName
          End With
       End If
     Next
     Set oChart = Nothing: Set oSerie = Nothing: Set oSerieA = Nothing: Set oDataLabelsA = Nothing: Set oDataLabels = Nothing:
   Else
     MsgBox "Il n'y a pas de série sélectionnée"
  End If
End Sub

J'ai effectué des tests avec les graphiques Histogramme 2D et Courbe
Malgré le soin apporté à son développement et malgré les tests effectués, il est toujours possible qu'une faille existe dans cette procédure
N'hésitez pas à commenter et/ou à me faire part de vos remarques