Bonjour,
Peut-on ajouter 2 lignes horizontales en pointillé ou en couleur comme sur le graphique B de l'image (ajouté à la main sur l'image pour l'explication) pour suggérer la plage des valeurs normales quand la normale est comprise entre 2 valeurs ou 1 ligne quand la normale est "inf à"
Le graphique A est obtenu par une macro écrite par @job75
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ChartObjects(1).Visible = False 'masque le graphique
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 2 Or Target.Row < 4 Then Exit Sub
Dim c As Range, v, n%, a(), b(), Lmax%
Cancel = True
For Each c In Intersect(Rows(3), UsedRange)
v = Cells(Target.Row, c.Column)
If IsDate(c) And v <> "" Then
n = n + 1
ReDim Preserve a(1 To n): ReDim Preserve b(1 To n)
a(n) = c.Text
b(n) = v
If Len(v) > Lmax Then Lmax = Len(v)
End If
Next
If n = 0 Then Exit Sub
Unprotect 'déprotection, mot de passe à adapter
ThisWorkbook.Names.Add "X", a 'nom défini
ThisWorkbook.Names.Add "Y", b 'nom défini
With ChartObjects(1)
.Top = Target(2, 1).Top
.Left = Columns(6).Left
.Width = Columns(6).Resize(, 4 * n).Width
With .Chart.SeriesCollection(1)
.Name = Target(1)
.XValues = "='" & ThisWorkbook.Name & "'!X" 'abscisses
.Values = "='" & ThisWorkbook.Name & "'!Y" 'ordonnées
.MarkerSize = 14 + 3 * Lmax 'taille des marqueurs
End With
.Visible = Not .Visible 'affiche/masque le graphique
End With
Protect 'protection, mot de passe à adapter
End Sub
Merci
Peut-on ajouter 2 lignes horizontales en pointillé ou en couleur comme sur le graphique B de l'image (ajouté à la main sur l'image pour l'explication) pour suggérer la plage des valeurs normales quand la normale est comprise entre 2 valeurs ou 1 ligne quand la normale est "inf à"
Le graphique A est obtenu par une macro écrite par @job75
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ChartObjects(1).Visible = False 'masque le graphique
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 2 Or Target.Row < 4 Then Exit Sub
Dim c As Range, v, n%, a(), b(), Lmax%
Cancel = True
For Each c In Intersect(Rows(3), UsedRange)
v = Cells(Target.Row, c.Column)
If IsDate(c) And v <> "" Then
n = n + 1
ReDim Preserve a(1 To n): ReDim Preserve b(1 To n)
a(n) = c.Text
b(n) = v
If Len(v) > Lmax Then Lmax = Len(v)
End If
Next
If n = 0 Then Exit Sub
Unprotect 'déprotection, mot de passe à adapter
ThisWorkbook.Names.Add "X", a 'nom défini
ThisWorkbook.Names.Add "Y", b 'nom défini
With ChartObjects(1)
.Top = Target(2, 1).Top
.Left = Columns(6).Left
.Width = Columns(6).Resize(, 4 * n).Width
With .Chart.SeriesCollection(1)
.Name = Target(1)
.XValues = "='" & ThisWorkbook.Name & "'!X" 'abscisses
.Values = "='" & ThisWorkbook.Name & "'!Y" 'ordonnées
.MarkerSize = 14 + 3 * Lmax 'taille des marqueurs
End With
.Visible = Not .Visible 'affiche/masque le graphique
End With
Protect 'protection, mot de passe à adapter
End Sub
Merci