Graphique Supprimer des valeurs par vba

Version imprimable

Bonjour,
J'essaye de contourner une limite d'Excel, qui n'arrive pas à gérer l'abscisse lorsqu'il y a du texte dans les sources de données. Le problème étant que je ne peux pas supprimer ce texte de ma source.
Je cherche à détecter les valeurs non numériques dans seriesCollection.XValues, puis à retirer du graphique ces valeurs et la valeur en Y associée.
Voici mon code pour le moment (je vous passe les déclarations de variables) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Sub CorrigeGraphs()
    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
                    'EDIT : vba n'arrive pas à lire serie.XValues(i) ; for each fonctionne
                    'for i = 1 to Ubound(serie.XValues)                        
                         'if not isNumeric(serie.XValues(i)) then
                    i = 0       'compteur d'éléments
                    for each elmt in serie.XValues
                        i=i+1 
                        if not isNumeric(elmt) then    
                              'Là je ne trouve pas comment faire
 
                         end if
                    next elmt
                 next serie
            end if
        next graph
    next sh
end sub

Si quelqu'un a une petite idée je suis preneur !

Etienne

23/10/2015, 13h37
letienne

autre possibilité

ReBonjour,

j'ai l'impression d'être un peu dans une impasse, que le seul moyen est de jouer sur la définition des series :
=SERIE(titre;(valeursX);(ValeursY))
Le plus simple c'est de remplacer les adresses des valeurs par des valeurs brutes, mais après pour actualiser les graphs avec de nouvelles valeurs galère...
23/10/2015, 13h54
78chris

Bonjour

Ne peux-tu ajouter une colonne qui remplace le texte par autre chose ?
23/10/2015, 15h06
letienne

Bonjour Chris,

Cette solution ne me convient pas, tout simplement parce que ça va me demander énormément de temps.
J'avais songé également à faire une feuille masquée contenant uniquement les données utiles pour les graphiques mais c'est le même problème.
23/10/2015, 16h38
78chris

RE

Citation:

Envoyé par letienne

Bonjour Chris,

Cette solution ne me convient pas, tout simplement parce que ça va me demander énormément de temps...

Je pensais à une formule : donc c'est très rapide.

Solution

Bonjour,

Effectivement Chris, c'est bien plus simple avec ta solution. Voici un code qui fait le taf :
S'il y a du texte en abscisse, écrit une formule et décale la source du graphique vers la nouvelle plage.

Code:

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