légende axe abscisse

[djstroubi]

Bonjour,

je souhaiterais savoir si il est possible que la valeur minimale sur l'axe des abscisse d' un graphique change automatiquement mais que c'est moi qui décide quelle est cette valeur.
C'est à dire que si je met par exemple 16:00 dans une cellule, automatiquement le graphique a comme valeur minimale en abscisse 16:00

cordialement

 

[job75]

Re : légende axe abscisse

Bonjour djstroubi,

On suppose :

- que le graphique se nomme "Graphique 1" et qu'il se trouve dans la feuille de calcul,

- que le minimum de l'axe des abscisses (une heure) est entré en cellule D2.

La macro à placer dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$2" And IsDate(Target.Text) Then 'adapter au besoin
  ActiveSheet.ChartObjects("Graphique 1").Chart.Axes(xlCategory).MinimumScale = Target
End If
End Sub

Edit : j'ai testé sur un graphique en Nuage de points

A+

 

[djstroubi]

Re : légende axe abscisse

J'ai essayé sur un graphique tous simple mais je n'arrive pas a faire fonctionner la macro. Il me trouve une erreur

Et dans mon autre fichier si le graphique est dans une autre feuille de calcul séparée appellé graph lundi et que l'heure est dans la feuille lundi en [A75].

@+

Bonjour djstroubi,

On suppose :

- que le graphique se nomme "Graphique 1" et qu'il se trouve dans la feuille de calcul,

- que le minimum de l'axe des abscisses (une heure) est entré en cellule D2.

La macro à placer dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$2" And IsDate(Target.Text) Then 'adapter au besoin
  ActiveSheet.ChartObjects("Graphique 1").Chart.Axes(xlCategory).MinimumScale = Target
End If
End Sub

Edit : j'ai testé sur un graphique en Nuage de points

A+

 

[job75]

Re : légende axe abscisse

Re,

Je suis sous Excel 2003 qui n'ouvre que les fichiers .xls 🙄

A+

 

[djstroubi]

Re : légende axe abscisse

Re,

je te l'envoi sous excel 2003

 

[job75]

Re : légende axe abscisse

Bonjour djstroubi,

Il s'agit d'un graphique Barres.

Sous Excel 2003 en tous cas, on ne peut pas manipuler le minimum de l'axe des abscisses 😡 il faut pour ça un graphique en Nuage de points.

A+

 

[job75]

Re : légende axe abscisse

Re,

Pardon pardon, j'ai confondu avec un histogramme, je regarde ça.

A+

 

[job75]

Re : légende axe abscisse

Re,

Bon, il y avait juste 2 modifications à faire pour adapter la macro :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$2" And IsDate(Target.Text) Then 'adapter au besoin
  ActiveSheet.ChartObjects("[COLOR="Red"]Graphique 2[/COLOR]").Chart.Axes([COLOR="Red"]xlValue[/COLOR]).MinimumScale = Target
End If
End Sub

A+

 

[djstroubi]

Re : légende axe abscisse

Re,

C'est parfait ca marche nikel
Cependant si j'ai plusieurs graphique sur une feuille séparés de la feuille de données qu'est ce que je doit modifier parce que j'ai essayer de bidouiler mais ca ne marche pas

a+

Re,

Bon, il y avait juste 2 modifications à faire pour adapter la macro :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$2" And IsDate(Target.Text) Then 'adapter au besoin
  ActiveSheet.ChartObjects("[COLOR="Red"]Graphique 2[/COLOR]").Chart.Axes([COLOR="Red"]xlValue[/COLOR]).MinimumScale = Target
End If
End Sub

A+

 

[djstroubi]

Re : légende axe abscisse

le code final au projet est le suivant

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Graph As Object
Dim G As ChartObject
'La donnée horaire modifiable est placée sur une feuille "JourX" en D2
If Target.Address = "$D$2" And IsDate(Target.Text) Then
On Error Resume Next
Set Graph = Charts("graph " & Sh.Name)
'Si la feuille "graph JourX" existe...
If Not Graph Is Nothing Then
'... on modifie la valeur de départ en abscisse sur chaque graphique
With Graph
.Axes(xlValue).MinimumScale = Target
For Each G In .ChartObjects
G.Chart.Axes(xlValue).MinimumScale = Target
Next G
End With
End If
End If
End Sub

merci a tous ceux qui m'on aidé

cordialement