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 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
| Sub Graph() 'Graphique :
Dim G1 As Chart
Dim ws1 As Worksheet
Dim PlageDonnees1 As Range
Dim PlageX1 As Range
Dim PlageY1 As Range
Dim MaSerie1 As Series
Dim Compteur1 As Long
Dim Col1 As Long
Dim Lig1 As Long
Set ws1 = ThisWorkbook.Worksheets("Feuille de données du graphique")
Lig1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row 'Recherche la dernière ligne contenant une donnée
Col1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column - 1 'Recherche la dernière colonne contenant une donnée
Lig1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row 'Recherche la dernière ligne contenant une donnée
ws1.[A1] = "Nombre d'onde (cm-1)"
ws1.[A1].Characters(Start:=18, Length:=2).Font.Superscript = True
Application.ScreenUpdating = False
With ws1
Set PlageDonnees1 = .Range(.Cells(1, 1), .Cells(Lig1, Col1)) ' Définition de la plage de données
End With
On Error Resume Next
Set G1 = ThisWorkbook.Charts("mon graphique") 'verif
On Error GoTo 0
If Not G1 Is Nothing Then
G1.ChartArea.Clear 'Effacement des données du graphe
Else
Set G1 = ThisWorkbook.Charts.Add 'Ajout d'une feuille mon graphique au classeur
G1.Name = "mon graphique"
End If
Set G1 = Nothing
G1.ChartType = xlXYScatter 'Définition du type de graphique (nuage de points)
Set PlageX1 = PlageDonnees1.Columns(1)
For Compteur1 = 1 To Col1
Set PlageY1 = PlageX1.Offset(, Compteur1)
Set MaSerie1 = G1.SeriesCollection.NewSeries
With MaSerie1 'Formattage des séries de données
.Values = PlageY1
.XValues = PlageX1
.Name = PlageDonnees1.Cells(1, 1).Offset(, Compteur1)
.Border.ColorIndex = 1 'Noir
.Border.Weight = xlHairline
.Border.LineStyle = xlContinuous
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 3
.Shadow = True
End With
G1.HasLegend = False
G1.HasTitle = False
With G1.Axes(xlCategory) 'axe des abscisses
.HasTitle = True 'définition du titre des abscisses
.AxisTitle.Characters.Text = "Nombre d'onde (cm-1)"
.AxisTitle.Font.ColorIndex = 3
.AxisTitle.Characters(Start:=18, Length:=2).Font.Superscript = True
.AxisTitle.Font.Name = "Arial"
.AxisTitle.Font.FontStyle = "Gras"
.AxisTitle.Font.Size = 12
.HasMajorGridlines = True 'Grille principale activée
.HasMinorGridlines = True 'Grille secondaire activée
.MajorGridlines.Border.ColorIndex = 16 'couleur de la grille principale
.MajorGridlines.Border.Weight = xlHairline 'taille du trait de la grille principale
.MajorGridlines.Border.LineStyle = xlDash 'type de trait de la grille principale
.MinorGridlines.Border.ColorIndex = 15 'couleur de la grille secondaire
.MinorGridlines.Border.Weight = xlHairline 'taille du trait de la grille secondaire
.MinorGridlines.Border.LineStyle = xlDot 'type de trait de la grille secondaire
.MinimumScale = 400 'valeur minimale
.MaximumScale = 4000 'valeur maximale
.MinorUnit = 50 'unité secondaire
.MajorUnit = 200 'unité principale
.Crosses = xlMaximum 'ordonnée à gauche
.ReversePlotOrder = True 'échelle en ordre inverse
.ScaleType = xlLinear
.DisplayUnit = xlNone
.MajorTickMark = xlCross 'position des unités principales
.MinorTickMark = xlInside 'position des unités secondaires
.TickLabelPosition = xlNextToAxis 'position des étiquette de données
With .Border 'couleur et taille de l'axe
.ColorIndex = 3 'couleur rouge
.Weight = xlThin 'épaisseur
.LineStyle = xlContinuous 'type
End With
With .TickLabels.Font 'Formatage des étiquettes de données
.Name = "Arial" 'Police
.FontStyle = "Normal" 'formattage
.Size = 10 'taille
.Strikethrough = False 'barrée
.Superscript = False 'exposant
.Subscript = False 'indice
.OutlineFont = False '
.Shadow = False 'transparence
.Underline = xlUnderlineStyleNone 'souligné
.ColorIndex = 3 'couleur (3=Rouge)
.Background = xlAutomatic 'couleur du fond
End With
End With
With G1.Axes(xlValue) 'axe des ordonnées
.HasTitle = True 'définition du titre des ordonnées
.AxisTitle.Characters.Text = "Absorbance (U.A.)"
.AxisTitle.Font.ColorIndex = 3
.AxisTitle.Font.Name = "Arial"
.AxisTitle.Font.FontStyle = "Gras"
.AxisTitle.Font.Size = 12
.HasMajorGridlines = True
.HasMinorGridlines = True
.MajorGridlines.Border.ColorIndex = 16 'couleur de la grille principale
.MajorGridlines.Border.Weight = xlHairline 'taille du trait de la grille principale
.MajorGridlines.Border.LineStyle = xlDash 'type de trait de la grille principale
.MinorGridlines.Border.ColorIndex = 15 'couleur de la grille secondaire
.MinorGridlines.Border.Weight = xlHairline 'taille du trait de la grille secondaire
.MinorGridlines.Border.LineStyle = xlDot 'type de trait de la grille secondaire
.MinimumScale = 0 'valeur minimale
.MaximumScale = 3.5 'valeur maximale
.MinorUnit = 0.1 'unité secondaire
.MajorUnit = 0.5 'unité principale
.Crosses = xlCustom 'Défini à quelle valeur l'axe X coupe l'axe Y
.CrossesAt = 0 'Défini à quelle valeur l'axe X coupe l'axe Y
.ReversePlotOrder = False 'échelle en ordre inverse
.ScaleType = xlLinear
.DisplayUnit = xlNonne
.MajorTickMark = xlCross 'position des unités principales
.MinorTickMark = xlInside 'position des unités secondaires
.TickLabelPosition = xlNextToAxis 'position des étiquette de données
With .Border 'couleur et taille de l'axe
.ColorIndex = 3 'couleur rouge
.Weight = xlThin 'épaisseur
.LineStyle = xlContinuous 'type
End With
With .TickLabels.Font 'Formatage des étiquettes de données
.Name = "Arial" 'Police
.FontStyle = "Normal" 'formattage
.Size = 10 'taille
.Strikethrough = False 'barrée
.Superscript = False 'exposant
.Subscript = False 'indice
.OutlineFont = False '
.Shadow = False 'transparence
.Underline = xlUnderlineStyleNone 'souligné
.ColorIndex = 3 'couleur (3=Rouge)
.Background = xlAutomatic 'couleur du fond
End With
End With
Next Compteur1
For Each MaSerie1 In G1.SeriesCollection
MaSerie1.FormulaR1C1Local = Replace(MaSerie1.FormulaR1C1Local, "L1C", "L2C")
Next MaSerie1
Application.ScreenUpdating = True
End Sub |
Partager