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
|
Dim sh As Worksheet, Graph As ChartObject, Serie As Series, HasText As Boolean, Ligne(1) As Long, Col As Long, i As Long
Dim FormuleTxt As String, FormuleEclatee, newAbscisse As String
For Each sh In ActiveWorkbook.Worksheets
For Each Graph In sh.ChartObjects
Graph.Activate
If Graph.Chart.ChartType = xlXYScatter Then
For Each Serie In Graph.Chart.SeriesCollection
HasText = False
For Each elmt In Serie.XValues
If Not IsNumeric(elmt) Then HasText = True 'Attention, Ne fonctionne pas sous XL-2010
Next
If HasText Then
'Récupération de la formule
FormuleTxt = Serie.FormulaR1C1
'Isolation de la définition de l'abscisse
FormuleEclatee = Split(FormuleTxt, ",")
'Récupération des lignes et colonnes
Ligne(0) = Split(Split(FormuleEclatee(1), "R")(1), "C")(0)
Ligne(1) = Split(Split(FormuleEclatee(1), "R")(2), "C")(0)
Col = Split(Split(FormuleEclatee(1), "R")(2), "C")(1)
'Ecriture des formule 50 colonnes plus à droite
For i = Ligne(0) To Ligne(1)
sh.Cells(i, Col + 50).FormulaR1C1 = "=if(isnumber(RC[-50]),RC[-50],0)"
sh.Cells(i, Col + 50).Font.Color = vbWhite
Next i
'Réécriture de la formule des abscisses
newAbscisse = Replace(FormuleEclatee(1), "C" & Col, "C" & Col + 50)
'Actualisation du graphique
FormuleTxt = Replace(FormuleTxt, FormuleEclatee(1), newAbscisse)
Serie.FormulaR1C1 = FormuleTxt
End If
Next Serie
End If
Next Graph
Next sh |
Partager