Afficher la légende d'un graphique sur le dernier graphique
Fermé
bassmart
Messages postés277Date d'inscriptionjeudi 19 février 2015StatutMembreDernière intervention30 août 2022
-
11 mai 2016 à 15:39
Bonjour,
J'ai une code que j"ai créé pour afficher jusqu'à trois graphiques sur la même feuille et s'il y a plus de 3 graphique, je crée une nouvelle feuille pour les afficher.
Le nombre de graphique est déterminé à l'aide d'un ComboBox. Ce que j'ai fait, je pré-détermine les endroit ou ma valeur ".HasLegend=true" et ou elle redevient "False" et j'utilise une fonction "if" pour faire afficher ma légende.
Mais le problème, c'est que si j'ai exemple 2 graphiques à faire afficher, il n'y aura pas de légende parce que j'ai placé "True" au troisième graphique.
Je voudrais que place la légende en bas du dernier graphique de chacune des feuilles peut importe s'il y en a 1, 2 ou 3 graphique.
Voici mon code:
Option Explicit
[/contents/446-fichier-sub Sub] graphique()
Dim Grf As ChartObject
Dim Sh As Worksheet
Dim nom As String, DerLig As Integer, i As Integer, DerCol As Integer
Dim col, MyRange As Range, Legende As Boolean, Min As Integer, Max As Integer
DerLig = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
DerCol = Sheets(1).Cells(2, Cells.Columns.Count).End(xlToLeft).Column
For i = 1 To UserForm2.ComboBox1.Value
Select Case i
Case 1
Set Sh = Sheets("graphique")
Set Grf = Sh.ChartObjects.Add(60, 100, 600, 210)
nom = Sheets(1).Range("J1").Value
col = Split(Columns(10).Address, ":")(1)
Set MyRange = Sheets(1).Range("J2:J" & DerLig)
Max = Application.WorksheetFunction.Max(MyRange)
Min = Application.WorksheetFunction.Min(MyRange)
Case 2
Set Sh = Sheets("graphique")
Set Grf = Sh.ChartObjects.Add(60, 330, 600, 210)
nom = Sheets(1).Range("K1").Value
col = Split(Columns(11).Address, ":")(1)
Set MyRange = Sheets(1).Range("K2:K" & DerLig)
Max = Application.WorksheetFunction.Max(MyRange)
Min = Application.WorksheetFunction.Min(MyRange)
Case 3
Set Sh = Sheets("graphique")
nom = Sheets(1).Range("L1").Value
Set Grf = Sh.ChartObjects.Add(60, 550, 600, 230)
col = Split(Columns(12).Address, ":")(1)
Set MyRange = Sheets(1).Range("L2:L" & DerLig)
Max = Application.WorksheetFunction.Max(MyRange)
Min = Application.WorksheetFunction.Min(MyRange)
Legende = Grf.Chart.HasLegend = True
Case 4
Set Sh = Sheets("graphique2")
nom = Sheets(1).Range("M1").Value
Set Grf = Sh.ChartObjects.Add(60, 100, 600, 200)
col = Split(Columns(13).Address, ":")(1)
Set MyRange = Sheets(1).Range("M2:M" & DerLig)
Max = Application.WorksheetFunction.Max(MyRange)
Min = Application.WorksheetFunction.Min(MyRange)
Legende = Grf.Chart.HasLegend = False
Case 5
Set Sh = Sheets("graphique2")
nom = Sheets(1).Range("N1").Value
Set Grf = Sh.ChartObjects.Add(60, 320, 600, 200)
col = Split(Columns(14).Address, ":")(1)
Set MyRange = Sheets(1).Range("N2:N" & DerLig)
Max = Application.WorksheetFunction.Max(MyRange)
Min = Application.WorksheetFunction.Min(MyRange)
Case 6
Set Sh = Sheets("graphique2")
nom = Sheets(1).Range("O1").Value
Set Grf = Sh.ChartObjects.Add(60, 540, 600, 230)
col = Split(Columns(15).Address, ":")(1)
Set MyRange = Sheets(1).Range("O2:O" & DerLig)
Max = Application.WorksheetFunction.Max(MyRange)
Min = Application.WorksheetFunction.Min(MyRange)
Legende = Grf.Chart.HasLegend = True
Case 7
Set Sh = Sheets("graphique3")
nom = Sheets(1).Range("P1").Value
Set Grf = Sh.ChartObjects.Add(60, 760, 600, 200)
col = Split(Columns(16).Address, ":")(1)
Set MyRange = Sheets(1).Range("P2:P" & DerLig)
Max = Application.WorksheetFunction.Max(MyRange)
Min = Application.WorksheetFunction.Min(MyRange)
Legende = Grf.Chart.HasLegend = False
Case 8
Set Sh = Sheets("graphique3")
nom = Sheets(1).Range("Q1").Value
Set Grf = Sh.ChartObjects.Add(60, 760, 600, 200)
col = Split(Columns(17).Address, ":")(1)
Set MyRange = Sheets(1).Range("Q2:Q" & DerLig)
Max = Application.WorksheetFunction.Max(MyRange)
Min = Application.WorksheetFunction.Min(MyRange)
Case 9
Set Sh = Sheets("graphique3")
nom = Sheets(1).Range("R1").Value
Set Grf = Sh.ChartObjects.Add(60, 760, 600, 230)
col = Split(Columns(18).Address, ":")(1)
Set MyRange = Sheets(1).Range("R2:R" & DerLig)
Max = Application.WorksheetFunction.Max(MyRange)
Min = Application.WorksheetFunction.Min(MyRange)
Legende = Grf.Chart.HasLegend = True
End Select
With Grf.Chart
If Legende = True Then
With .Legend
With .Border
.Color = vbBlack
.LineStyle = xlContinuous
End With
.Format.Line.Weight = 0.25
.Format.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Position = xlLegendPositionBottom
End With
Else
.HasLegend = False
End If
With .PlotArea
.Border.LineStyle = xlContinuous
.Border.Weight = xlThin
End With
.HasTitle = True
.ChartTitle.Text = "No piézomètre: " & Mid(nom, 23, 14)
.ChartTitle.Left = 21
With .ChartTitle.Font
.Size = 10
.Name = "Arial"
End With
.ChartType = xlLine
.SeriesCollection.NewSeries
With .SeriesCollection(1)
.Name = "2016" ' À changer pour que la date change avec les données de la colonne E
.Format.Line.Weight = xlThin
.Values = Sheets(1).Range(col & "2" & ":" & col & DerLig)
.XValues = Sheets(1).Range("E2" & ":E" & DerLig)
End With
With .Axes(xlValue, xlPrimary)
.HasTitle = True
.AxisTitle.Characters.Text = "Pression (KPa)"
.MinorTickMark = xlTickMarkInside
.AxisTitle.Font.Bold = False
End With
'ajouter une condition pour déterminer l'échelle par rapport au min/max
With .Axes(xlCategory, xlPrimary)
.HasTitle = True
.AxisTitle.Characters.Text = "Date de lecture"
.AxisTitle.Font.Bold = False
.CategoryType = xlCategoryScale
.TickMarkSpacing = 20
.TickLabelSpacing = 40
End With
End With
Next i
Set Grf = Nothing
Set Sh = Nothing
End Sub
Merci d'avance pour votre aide!
A voir également:
Afficher la légende d'un graphique sur le dernier graphique