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
| Public Sub graphique(namefileXls As String, compteur As String)
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlSheetDonnées As Excel.Worksheet
Dim nbSemaines as Integer
' Initialisation des variables xlApp et xlBook
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Open(namefileXls)
' Détermination du nombre lignes de la feuille par défaut
nbUsedRows = xlBook.Worksheets("Requête Graphe").UsedRange.Rows.Count
' Ajout de la feuille permettant de filtrer les faisceaux
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "Calcul"
xlBook.Worksheets("Requête Graphe").Activate
xlBook.Worksheets("Requête Graphe").Range("C2:C" & nbUsedRows).Copy Destination:=xlBook.Worksheets("Calcul").Range("A1")
' ****** Cette portion plante une fois sur deux ?????? *********
xlBook.Worksheets("Requête Graphe").Range("C1").Select
Excel.Selection.Sort key1:=xlBook.Worksheets("Requête Graphe").Cells(1, 3), _
order1:=xlAscending, header:=xlGuess, ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
/*** Partie de traitement des données (non incluse dans ce code)******/
/*** Dans cette partie j'initialise et complète également la feuille "Données" ***/
' Création du graphique
Dim MonGraphe As Excel.Chart
Set MonGraphe = xlBook.Charts.Add
MonGraphe.chartType = xlXYScatterLines
MonGraphe.SetSourceData xlBook.Worksheets("Données").Range(xlBook.Worksheets("Données").Cells(1, 1), xlBook.Worksheets("Données").Cells(99, CInt(nbSemaines + 1))), xlColumns
With MonGraphe
.HasTitle = True
' Ajout du titre de l'objet graphique
With .ChartTitle
.Characters.Text = "Evolution du compteur " & compteur
.Shadow = True
.Border.Weight = xlHairline
End With
' Paramétrage de l'axe des ordonnées avec ajout de titre
With .Axes(xlValue, xlPrimary)
.HasTitle = True
.AxisTitle.Characters.Text = compteur
End With
' Paramétrage de l'axe des abscisses avec ajout de la légende
With .Axes(xlCategory, xlPrimary) '
.HasTitle = True
.AxisTitle.Characters.Text = "Semaines"
End With
End With
xlBook.Save
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End Sub |
Partager