bonjours a tous
j'ai un code qui me gêner un graphique dan suserform
il marche bien quand il y a peut de données mais plant avec beaucoup de donnée??
le ficher et trop gros je ne peut pas le mettre sauf si vous avez un lien pour mettre les gros ficher
j'ai un code qui me gêner un graphique dan suserform
il marche bien quand il y a peut de données mais plant avec beaucoup de donnée??
le ficher et trop gros je ne peut pas le mettre sauf si vous avez un lien pour mettre les gros ficher
Code:
Sub moisTemps()
'---------------------
'- graphique mensuel -
'- Temperature -
'---------------------
Set F1 = Worksheets(Feuil11.Name)
Application.ScreenUpdating = False
On Error Resume Next
F1.Shapes("Graphique1").Delete
Dim mois As Integer, Année As Long, Plage As Range, i As Integer
Select Case UserForm2.mois1.Value
Case "Janvier"
mois = 1
Case "Fevrier"
mois = 2
Case "Mars"
mois = 3
Case "Avril"
mois = 4
Case "Mai"
mois = 5
Case "Juin"
mois = 6
Case "Juillet"
mois = 7
Case "Aout"
mois = 8
Case "Septembre"
mois = 9
Case "Octobre"
mois = 10
Case "Novembre"
mois = 11
Case "Déscembre"
mois = 12
Case Else
Exit Sub
End Select
Année = UserForm2.année1.Value
If Année = 0 Then Exit Sub
With Sheets("Données")
i = 2
While .Cells(i, 1) <> ""
If Month(.Cells(i, 1)) = mois And Year(.Cells(i, 1)) = Année Then
If Plage Is Nothing Then
Set Plage = Union(.Cells(i, 3), .Cells(i, 4), .Cells(i, 14)) '--- choix des colonnes --
Else
Set Plage = Union(Plage, .Cells(i, 3), .Cells(i, 4), .Cells(i, 14)) '--- choix des colonnes ---
End If
End If
i = i + 1
Wend
End With
If Plage Is Nothing Then
MsgBox "Il n'y a pas de valeurs à cette date !", vbExclamation, "Erreur"
Exit Sub
End If
Charts.Add
'--- Type de graphique ---
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=Plage, PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:=F1.Name
End With
With ActiveChart.Axes(xlCategory)
.MinimumScale = Plage.Cells(1, 1).Value
.MaximumScale = Plage.Cells(Plage.Rows.Count, 1).Value
End With
[A1].Select
fichier = ActiveWorkbook.Path & "\" & "graphef1.gif"
Graph.Export Filename:=fichier, FilterName:="GIF"
UserForm2.Image1.Picture = LoadPicture(fichier)
Application.ScreenUpdating = True
End Sub