Macro Excel VBA : graphiques automatique

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
Configuration: Windows XP
Internet Explorer 6.0

3 réponses

  1. 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
    1. 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??
      1. 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