Les Allergies
Alimentaires
Posez votre question Signaler

Macro Excel VBA : graphiques automatique

techneric 6Messages postés 3 janvier 2007Date d'inscription - Dernière réponse le 18 oct. 2011 à 12:51
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
Lire la suite 

Macro Excel VBA : graphiques automatique »

3 réponses
Réponse
+2
moins plus
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
Ajouter un commentaire
Réponse
+0
moins plus
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??
Ajouter un commentaire
Réponse
+0
moins plus
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
Ajouter un commentaire
Ce document intitulé « Macro Excel VBA : graphiques automatique » issu de CommentCaMarche (www.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.
Dossier à la une
Passage au tout numérique : quel coût pour les particuliers ?