Macro Excel VBA : graphiques automatique
techneric
Messages postés
6
Statut
Membre
-
chris -
chris -
bjr, j'ai 1 macro qui génère automatiquement des graphes/graphiques, ça marche.
Mais, 1 fois le graphe créé, sur une boucle, je n'arrive pas à reprndre le graphe pour modifier le style de la courbe, quelqu'un connait-il la solution ?
Merci.
[code]
Sub ifcourbes()
'
' ifcourbes Macro
' Macro enregistrée le 12/02/2007 par ericE
'
Sheets("tableau").Select
Range("AN6").Select
'maxlig = Range("B65535").End(xlUp).Row
maxlign = 6
For i = 2 To maxlign
'Sheets("tableau").Select
recup = Cells(i, 35)
If Cells(i, 31) < 500 Then
'Sheets("tableau").Select
Select Case recup
Case ""
Cells(i, 42) = "tropfort"
Case Is > 0.7
Cells(i, 42) = "vu1"
Case 0.6 To 0.7
Cells(i, 42) = "vu11"
Case Is < 0.6
Cells(i, 42) = "vu121"
End Select
Else
Select Case recup
Case ""
Cells(i, 43) = "nonvu"
Case Is > 0.7
appelfonction = casfort(i)
Case 0.6 To 0.7
Cells(i, 43) = "vu11"
Case Is < 0.6
Cells(i, 43) = "vu121"
End Select
End If
Next
Range("AN6").Select
End Sub
Function casfort(j) As Integer
'Public ChartList As Integer
Dim sha As ChartObject
maxlign = 5
m = 1
For j = 2 To maxlign
'k = j + 22
Sheets("fort").Select
Cells(j * 22, 1).Select
'Cells(j * 25, 1).Select
'Cells(j * 22, 1).Select
Charts.Add
'ChartList = ActiveSheet.ChartObjects.Count
'm = ChartList * 15
'ActiveChart.ChartType = xlLine
'ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:= _
"Courbes à deux axes"
ActiveChart.SetSourceData Source:=Sheets("tableau").Range("A1:AM123"), _
PlotBy:=xlRows
ActiveChart.SeriesCollection.NewSeries
'Sheets("tableau").Select
ActiveChart.SeriesCollection(1).XValues = _
"=(tableau!R1C3,tableau!R1C4,tableau!R1C6,tableau!R1C8,tableau!R1C10)"
'k = j + 1
'lignier2 = "=(tableau!R" & j & "C3," & "tableau!R" & j & "C4," _
& "tableau!R" & j & "C6," & "tableau!R" & j & "C8," & "tableau!R" & j & "C10)"
lignier1 = "=(tableau!R" & j & "C3," & "tableau!R" & j & "C4," _
& "tableau!R" & j & "C6," & "tableau!R" & j & "C8," & "tableau!R" & j & "C10)"
lignier2 = "=(tableau!R" & j & "C5," & "tableau!R" & j & "C7," _
& "tableau!R" & j & "C9," & "tableau!R" & j & "C11," & "tableau!R" & j & "C13)"
'title2 = "=(tableau!R" & j & "C1," & "tableau!R" & j & "C2"
valide1 = Sheets("tableau").Cells(j, 1)
validier = Sheets("tableau").Cells(j, 2)
valide = valide1 & " " & validier
ActiveChart.SeriesCollection(1).Values = lignier1
ActiveChart.SeriesCollection(1).Name = "=""Em"""
'ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:= _
"Courbes à deux axes"
ActiveChart.SeriesCollection(2).Values = lignier2
ActiveChart.SeriesCollection(2).Name = "=""Energie"""
ActiveChart.Location Where:=xlLocationAsObject, Name:="TBpforte"
ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:= _
"Courbes à deux axes"
Sheets("TBpforte").Select
ActiveChart.PlotArea.Select
'ActiveChart.ChartType = xlLine
ActiveWindow.Visible = False
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = valide
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "mois"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "KW"
.Axes(xlCategory, xlSecondary).HasTitle = False
.Axes(xlValue, xlSecondary).HasTitle = False
End With
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
ActiveChart.HasDataTable = False
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlValue).Select
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
With Selection
.MarkerBackgroundColorIndex = xlAutomatic
.MarkerForegroundColorIndex = 46
.MarkerStyle = xlDiamond
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
With Selection.Border
.ColorIndex = 46
.Weight = xlThin
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = 46
.MarkerForegroundColorIndex = 46
.MarkerStyle = xlDiamond
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
Sheets("tableau").Select
Next
Sheets("fort").Select
Range("A1").Select
'Rows("1:15").Select
Rows("1:30").Select
Selection.Delete Shift:=xlUp
'Range("A1").Select
Columns("A:B").EntireColumn.Delete
'Columns("A:C").EntireColumn.Delete
End Function
[/code]
msg : "La méthode Select de la classe Axis a échoué."
ActiveChart.Axes(xlCategory).Select à déboder
pb : "ActiveChart.PlotArea.Select" ne marche pas sur une boucle
pour 1 seule courbe, c'est OK, sinon, non sur une boucle !
quelqu'un sait-il ?
Merci
Techneric
Mais, 1 fois le graphe créé, sur une boucle, je n'arrive pas à reprndre le graphe pour modifier le style de la courbe, quelqu'un connait-il la solution ?
Merci.
[code]
Sub ifcourbes()
'
' ifcourbes Macro
' Macro enregistrée le 12/02/2007 par ericE
'
Sheets("tableau").Select
Range("AN6").Select
'maxlig = Range("B65535").End(xlUp).Row
maxlign = 6
For i = 2 To maxlign
'Sheets("tableau").Select
recup = Cells(i, 35)
If Cells(i, 31) < 500 Then
'Sheets("tableau").Select
Select Case recup
Case ""
Cells(i, 42) = "tropfort"
Case Is > 0.7
Cells(i, 42) = "vu1"
Case 0.6 To 0.7
Cells(i, 42) = "vu11"
Case Is < 0.6
Cells(i, 42) = "vu121"
End Select
Else
Select Case recup
Case ""
Cells(i, 43) = "nonvu"
Case Is > 0.7
appelfonction = casfort(i)
Case 0.6 To 0.7
Cells(i, 43) = "vu11"
Case Is < 0.6
Cells(i, 43) = "vu121"
End Select
End If
Next
Range("AN6").Select
End Sub
Function casfort(j) As Integer
'Public ChartList As Integer
Dim sha As ChartObject
maxlign = 5
m = 1
For j = 2 To maxlign
'k = j + 22
Sheets("fort").Select
Cells(j * 22, 1).Select
'Cells(j * 25, 1).Select
'Cells(j * 22, 1).Select
Charts.Add
'ChartList = ActiveSheet.ChartObjects.Count
'm = ChartList * 15
'ActiveChart.ChartType = xlLine
'ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:= _
"Courbes à deux axes"
ActiveChart.SetSourceData Source:=Sheets("tableau").Range("A1:AM123"), _
PlotBy:=xlRows
ActiveChart.SeriesCollection.NewSeries
'Sheets("tableau").Select
ActiveChart.SeriesCollection(1).XValues = _
"=(tableau!R1C3,tableau!R1C4,tableau!R1C6,tableau!R1C8,tableau!R1C10)"
'k = j + 1
'lignier2 = "=(tableau!R" & j & "C3," & "tableau!R" & j & "C4," _
& "tableau!R" & j & "C6," & "tableau!R" & j & "C8," & "tableau!R" & j & "C10)"
lignier1 = "=(tableau!R" & j & "C3," & "tableau!R" & j & "C4," _
& "tableau!R" & j & "C6," & "tableau!R" & j & "C8," & "tableau!R" & j & "C10)"
lignier2 = "=(tableau!R" & j & "C5," & "tableau!R" & j & "C7," _
& "tableau!R" & j & "C9," & "tableau!R" & j & "C11," & "tableau!R" & j & "C13)"
'title2 = "=(tableau!R" & j & "C1," & "tableau!R" & j & "C2"
valide1 = Sheets("tableau").Cells(j, 1)
validier = Sheets("tableau").Cells(j, 2)
valide = valide1 & " " & validier
ActiveChart.SeriesCollection(1).Values = lignier1
ActiveChart.SeriesCollection(1).Name = "=""Em"""
'ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:= _
"Courbes à deux axes"
ActiveChart.SeriesCollection(2).Values = lignier2
ActiveChart.SeriesCollection(2).Name = "=""Energie"""
ActiveChart.Location Where:=xlLocationAsObject, Name:="TBpforte"
ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:= _
"Courbes à deux axes"
Sheets("TBpforte").Select
ActiveChart.PlotArea.Select
'ActiveChart.ChartType = xlLine
ActiveWindow.Visible = False
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = valide
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "mois"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "KW"
.Axes(xlCategory, xlSecondary).HasTitle = False
.Axes(xlValue, xlSecondary).HasTitle = False
End With
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
ActiveChart.HasDataTable = False
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlValue).Select
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
With Selection
.MarkerBackgroundColorIndex = xlAutomatic
.MarkerForegroundColorIndex = 46
.MarkerStyle = xlDiamond
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
With Selection.Border
.ColorIndex = 46
.Weight = xlThin
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = 46
.MarkerForegroundColorIndex = 46
.MarkerStyle = xlDiamond
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
Sheets("tableau").Select
Next
Sheets("fort").Select
Range("A1").Select
'Rows("1:15").Select
Rows("1:30").Select
Selection.Delete Shift:=xlUp
'Range("A1").Select
Columns("A:B").EntireColumn.Delete
'Columns("A:C").EntireColumn.Delete
End Function
[/code]
msg : "La méthode Select de la classe Axis a échoué."
ActiveChart.Axes(xlCategory).Select à déboder
pb : "ActiveChart.PlotArea.Select" ne marche pas sur une boucle
pour 1 seule courbe, c'est OK, sinon, non sur une boucle !
quelqu'un sait-il ?
Merci
Techneric
Configuration: Windows XP Internet Explorer 6.0
3 réponses
-
voila ca ne repond pa a ton prblm mai j généré un pti code qui cree des graph sur plusieur feuilles ...
Sub Macro3()
'
' Macro3 Macro
' Macro enregistrée le 02/06/2007 par Boomscud
'
'
For i = 1 To 50
Sheets("Feuil" & i & "").Select
Range("A2:B5").Select
Charts.Add
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Sheets("Feuil" & i & "").Range("A2:B5"), PlotBy:= _
xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Feuil" & i & ""
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowNone, LegendKey:=False
Next i
End Sub
si la feuille n'exisye pa la macro ne marche pa et c mn prblm pour le momen... si t'a la solution envoi la merci -
Bonjour,
Moi aussi j'ai une macro qui crée des graphiques et les mêmes sur une seul feuille. Mon probleme est que je n'arrive pas à placer tout mes graphes comme je veux.
Pouvez vous m'aider?? -
j ai trouver ca sur un forum ca devrait t'aider reste a l adapter
Dim ch As ChartObject
Dim Grap As String
Dim Hauteur As Long
Dim X As Long
Application.ScreenUpdating = False
X = 250
For Each ch In ActiveSheet.ChartObjects
Grap = ch.Name
ActiveSheet.ChartObjects(Grap).Activate
ActiveSheet.Shapes(Grap).ScaleWidth 0.91, msoFalse, msoScaleFromTopLeft 'redéfinir dimensions
ActiveSheet.Shapes(Grap).ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft 'redéfinir dimensions
Hauteur = ActiveSheet.Shapes(Grap).Height
ActiveSheet.Shapes(Grap).Left = 1 'redéfinir position dans feuille
ActiveSheet.Shapes(Grap).Top = X 'redéfinir position dans feuille
X = X + Hauteur + 10
Next ch
Application.ScreenUpdating = True
Range("a1").Selection