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
A voir également:
- Macro Excel VBA : graphiques automatique
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Liste déroulante excel - Guide
- Word et excel gratuit - Guide
- Si ou excel - Guide
- Excel compter cellule couleur sans vba - Guide
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
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??
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
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