Modifier le format des abscisses (X) en VBA pour un graphique multicourbes

Version imprimable

13/05/2019, 20h10
leblesois

Modifier le format des abscisses (X) en VBA pour un graphique multicourbes
Bonjour,

j'ai réalisé un graphique avec 3 courbes et la particularité est que je peux modifier par liste déroulante l'intitulé des axes X et Y et surtout les valeurs liées aux axes.

Le problème est que lorsque je sélectionne dans ma liste déroulante l'intitulé "DATE", les dates apparaissent au format nombre classique du type 42500, mais bien sur je veux voir 31/05 (par exemple). Je sais bien sur modifier manuellement le format, mais je vousdrais que ce soit ma macro qui le fasse automatiquement lorsque l'intitulé ="DATE".

J'ai essayé cela mais cela ne marche pas (sans doute car multicourbes) :
Code:

1 2 ActiveChart.Axes(xlCategory).Select Selection.TickLabels.NumberFormat = "jj/mm/aaaa"
Merci d'avance pour votre aide !
14/05/2019, 07h02
ARTURO83

Bonjour,

Pas tout compris, normalement les axes du graphique reprennent les mêmes format que la base de données.
Dans la BDD, sous quel format se présentent les dates: format NOMBRE ou format DATE?

Cdlt
14/05/2019, 13h45
leblesois

Les données sont au format date...
15/05/2019, 08h57
ARTURO83

Bonjour,

Pouvez-vous mettre à disposition votre fichier (sans données confidentielles) afin que l'on puisse se faire une idée du problème?

Cdlt
15/05/2019, 10h20
leblesois

1 pièce(s) jointe(s)

Citation:

Envoyé par ARTURO83

Bonjour,

Pouvez-vous mettre à disposition votre fichier (sans données confidentielles) afin que l'on puisse se faire une idée du problème?

Cdlt

Voici donc une récupération du fichier (le reste étant confidentiel...). Il n'y a donc qu'un graphique mais le principe est le bon. En modifiant la cellule en A13, les données "X" changent, et lorsque je choisi "DATE" les données restent au format numérique...

Merci pour votre aide

!Pièce jointe 475080

Voilà,

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Option Compare Text
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    If Target.Address = "$A$13" Then
        GRAPH = 2
        RR = 14
 
        '***********************CHANGEMENT DES AXES "X"***********************
        'EFFACE les anciennes données des 3 colonnes
        Application.EnableEvents = False
        COL1 = 14
        COL2 = 16
        COL3 = 18
        COL_X = 7
 
        Range(Cells(4, 14), Cells(1000000, 14)).ClearContents
        Range(Cells(4, 16), Cells(1000000, 16)).ClearContents
        Range(Cells(4, 18), Cells(1000000, 18)).ClearContents
 
        'Recupère les données des 3 courbes
        For G = 1 To 3
            With Sheets("Donnees_Graphe_Pick_Up_1_" & G)
                .Select
                DL = .Range("A1048576").End(xlUp).Row
                .Range(.Cells(1, Cells(2, 14).Value), .Cells(DL, Cells(2, 14).Value)).Select
            End With
            Selection.Copy
            Sheets("Graphe_01").Select
            If G = 1 Then
                Cells(4, 14).Select
            ElseIf G = 2 Then
                Cells(4, 16).Select
            Else
                Cells(4, 18).Select
            End If
            ActiveSheet.Paste
            Range("B10").Select
        Next G
 
        Application.EnableEvents = True
        ActiveSheet.ChartObjects("Graphique " & GRAPH).Activate
        ActiveChart.PlotArea.Select
        DL = Cells(1048576, 14).End(xlUp).Row
        ActiveChart.FullSeriesCollection(1).XValues = "=Graphe_01!R6C14:R" & DL & "C14"
 
        DL = Cells(1048576, 16).End(xlUp).Row
        ActiveChart.FullSeriesCollection(2).XValues = "=Graphe_01!R6C16:R" & DL & "C16"
 
        DL = Cells(1048576, 18).End(xlUp).Row
        ActiveChart.FullSeriesCollection(3).XValues = "=Graphe_01!R6C18:R" & DL & "C18"
 
        ActiveChart.Axes(xlCategory).Select
        ActiveChart.Axes(xlValue).TickLabels.NumberFormatLinked = -1 ' équivaut à cocher "lier à la source"
        Range("A1").Select
    End If
End Sub

Avec le fichier
Pièce jointe 475154

Cdlt

15/05/2019, 14h07
leblesois

Désolé, mais chez moi, cela ne fonctionne pas, mais il y a une avancée, je n'ai plus de message d'erreur ... Mais la date reste à 43000 au lieu de 21/05.

Y aurait-il une case à cocher dans outils / références ?
15/05/2019, 14h27
ARTURO83

Moi j'ai excel 2007 et ça marche, mais je suis obligé de remplacer

Code:

ActiveChart.FullSeriesCollection(2).XValues = "=Graphe_01!R6C16:R" & DL & "C16"

par

Code:

ActiveChart.SeriesCollection(2).XValues = "=Graphe_01!R6C16:R" & DL & "C16"

Juste pour voir, réessayez en changeant cette valeur(en rouge) pour chaque ligne concernée.

Cdlt
15/05/2019, 18h47
leblesois

Merci pour vos efforts, mais hélas, l'axe X reste au format 43000 et non pas au format date...

Pourriez-vous me dire quelles cases sont cochées chez vous au niveau d'outils / Références ?

Merci d'avance
16/05/2019, 07h17
ARTURO83

Bonjour,
Vu que nous avons des versions différentes d'excel, on va essayer autre chose,
-Ouvrez l'enregistreur de macro
-Clic droit sur l'axe des abscisses du graphique, mise en forme de l'axe.
-Dans l'option d'axe, cliquez sur "Nombre"
-Cochez "Lier à la source"
-Fermer
-Arrêtez l'enregistreur de macro

Dans la macro ainsi créée, la ligne obtenue est-elle différente de celle-ci?

Code:

ActiveChart.Axes(xlValue).TickLabels.NumberFormatLinked = -1

Remplacez-là si c'est le cas et faites des essais.

Cdlt