Débogage graphique VBA
Bonjour,
j'ai utilisé l'enregistreur de macro pour créer le code ci-dessous. Il fonctionne à peu près. C'est à dire qu'il y a des soucis mais si je clique sur Fin lorsqu'il me propose de faire le débogage cela fonctionne quand même.... Mais bon c'est pas top non plus quoi.... Le débogage se lance sur
ActiveChart.ChartTitle.Select
Pourquoi ... je n'en sais rien. Comme ce code a été fait avec l'enregistreur de macro j'imagine qu'il doit peut être vous paraîte tout bizarre .... j'en sais trop rien.
Qqun pense pouvoir l'améliorer ou déjà le rendre sans bug? Merci
Sub graphcouleurse31a()
'
' graphcouleurse31a Macro
'
ActiveSheet.Shapes.AddChart2(297, xlColumnStacked100).Select
ActiveChart.SetSourceData Source:=Sheets("Calcul_couleurs").Range("A3:E33")
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = "Répartition couleurs E31A"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
"Répartition couleurs E31A"
With Selection.Format.TextFrame2.TextRange.Characters(1, 25).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 25).Font
.BaselineOffset = 0
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(89, 89, 89)
.Fill.Transparency = 0
.Fill.Solid
.Size = 14
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Spacing = 0
.Strike = msoNoStrike
End With
ActiveChart.ChartArea.Select
ActiveChart.SetElement (msoElementDataLabelCenter)
End SubBonsoir,
Il serait plus simple pour toi de nous envoyer un fichier...
Cdlt.
Bonsoir et merci d'avoir pris le temps de me répondre.
Voici un fichier exemple.
Bonjour,
Voir exemple dans fichier joint.
A te relire.
Cdlt.
Option Explicit
Private Sub cmdCreerGraphique_Click()
Dim wsData As Worksheet, wsChart As Worksheet
Dim rngChart As Range
Dim objChart As ChartObject
Dim objLE As LegendEntry
Application.ScreenUpdating = False
Set wsData = Feuil1
Set wsChart = Feuil2
On Error Resume Next
wsChart.ChartObjects(1).Delete
On Error GoTo 0
Set rngChart = wsData.Cells(3, 1).CurrentRegion ' Attention!...
Set objChart = wsChart.ChartObjects.Add _
(Left:=wsChart.Columns("B").Left, _
Top:=wsChart.Rows(4).Top, _
Width:=400, _
Height:=250)
With objChart.Chart
.ChartType = xlColumnStacked
.SetSourceData Source:=rngChart, PlotBy:=xlColumns
.HasTitle = True
.ChartTitle.Text = wsData.Cells(1)
.HasLegend = True
.Legend.Position = xlTop
With .Parent
.Placement = xlFreeFloating
.Name = "Graphique " & wsData.Cells(1)
End With
.FullSeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(255, 0, 0) 'rouge
.FullSeriesCollection(2).Format.Fill.ForeColor.RGB = RGB(255, 255, 0) 'jaune
.FullSeriesCollection(3).Format.Fill.ForeColor.RGB = RGB(146, 208, 80) 'vert
.FullSeriesCollection(4).Format.Fill.ForeColor.RGB = RGB(0, 176, 80) 'vert2
With .Legend
.Font.Bold = True
.Font.Italic = True
For Each objLE In .LegendEntries
objLE.Font.Color = objLE.LegendKey.Interior.Color
Next
End With
End With
Set objChart = Nothing
Set rngChart = Nothing
Set wsChart = Nothing: Set wsData = Nothing
End SubJe te réponds tout de suite car comme d'habitude vos solutions sont géniales. Merci infiniment. Cela fonctionne parfaitement sur le fichier test
Dîtes moi si je me trompe, parce que je n'y connais pas grand chose. La macro est sur la feuille et non dans le code du bouton n'est ce pas?
Or, je souhaiterais ensuite copier coller le bouton 30 fois (sur des feuilles différentes) et qu'il fasse le graphique sur la feuille où il se trouve.
Je n'avais pas précisé cela. Je vous présente mes excuses. Je ne sais même pas si c'est possible d'ailleurs.
Je pense que j'y suis arrivé sur un bouton de commande copiable à l'infini. Enfin j'espère dîtes moi si c'est ça.
J'ai enlevé le private. J'ai ajouté activesheet là où doit se faire le graphique. Il y a d'autres choses à faire vous pensez ?
Sub cmdCreerGraphique_Click()
Dim wsData As Worksheet, wsChart As Worksheet
Dim rngChart As Range
Dim objChart As ChartObject
Dim objLE As LegendEntry
Application.ScreenUpdating = False
Set wsData = Feuil1
Set wsChart = ActiveSheet
On Error Resume Next
wsChart.ChartObjects(1).Delete
On Error GoTo 0
Set rngChart = wsData.Cells(3, 1).CurrentRegion ' Attention!...
Set objChart = wsChart.ChartObjects.Add _
(Left:=wsChart.Columns("B").Left, _
Top:=wsChart.Rows(4).Top, _
Width:=400, _
Height:=250)
With objChart.Chart
.ChartType = xlColumnStacked
.SetSourceData Source:=rngChart, PlotBy:=xlColumns
.HasTitle = True
.ChartTitle.Text = wsData.Cells(1)
.HasLegend = True
.Legend.Position = xlTop
With .Parent
.Placement = xlFreeFloating
.Name = "Graphique " & wsData.Cells(1)
End With
.FullSeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(255, 0, 0) 'rouge
.FullSeriesCollection(2).Format.Fill.ForeColor.RGB = RGB(255, 255, 0) 'jaune
.FullSeriesCollection(3).Format.Fill.ForeColor.RGB = RGB(146, 208, 80) 'vert
.FullSeriesCollection(4).Format.Fill.ForeColor.RGB = RGB(0, 176, 80) 'vert2
With .Legend
.Font.Bold = True
.Font.Italic = True
For Each objLE In .LegendEntries
objLE.Font.Color = objLE.LegendKey.Interior.Color
Next
End With
End With
Set objChart = Nothing
Set rngChart = Nothing
Set wsChart = Nothing: Set wsData = Nothing
End SubCette modification a l'air de fonctionner.
Il me semble si je comprends que dans le code, vous sélectionnez des lignes et des colonnes pour faire le graphique. Dans mon fichier test, il n'y avait qu'un tableau de données mais dans la réalité il y en a plusieurs. Il ne faudrait donc pas que cela sélectionne les lignes et les colonnes mais une plage de cellule. Est ce possible? D'autant plus qu'ensuite je voudrais modifier ce code pour l'adapter à d'autres plages de cellules.
Merci
Merci j'ai réussi à l'adapter à mon cas. Je vais essayer de le reproduire sur d'autres sélections maintenant. Merci. Je reviendrai vers vous si je n'y arrive pas.
Pour info voici le code que j'utilise donc. Si vous voulez le relire pour me dire si je n'ai pas mis de bêtises.
Merci.
Sub graphcouleurse31a()
'
' graphcouleurse31a Macro
'
'
Dim wsData As Worksheet, wsChart As Worksheet
Dim rngChart As Range
Dim objChart As ChartObject
Dim objLE As LegendEntry
Application.ScreenUpdating = False
Set wsData = Feuil43
Set wsChart = ActiveSheet
On Error Resume Next
wsChart.ChartObjects(1).Delete
On Error GoTo 0
Set rngChart = wsData.Cells(3, 1).CurrentRegion ' Attention!...
Set objChart = wsChart.ChartObjects.Add _
(Left:=wsChart.Columns("c").Left, _
Top:=wsChart.Rows(9).Top, _
Width:=600, _
Height:=250)
With objChart.Chart
.ChartType = xlColumnStacked
.SetSourceData Source:=Feuil43.Range("A3:E33")
.HasTitle = True
.ChartTitle.Text = wsData.Cells.Range("a2")
.HasLegend = True
.Legend.Position = xlTop
With .Parent
.Placement = xlFreeFloating
.Name = "Graphique " & wsData.Cells(1)
End With
.FullSeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(255, 0, 0) 'rouge
.FullSeriesCollection(2).Format.Fill.ForeColor.RGB = RGB(255, 255, 0) 'jaune
.FullSeriesCollection(3).Format.Fill.ForeColor.RGB = RGB(146, 208, 80) 'vert
.FullSeriesCollection(4).Format.Fill.ForeColor.RGB = RGB(0, 176, 80) 'vert2
With .Legend
.Font.Bold = True
.Font.Italic = True
For Each objLE In .LegendEntries
objLE.Font.Color = objLE.LegendKey.Interior.Color
Next
End With
End With
Set objChart = Nothing
Set rngChart = Nothing
Set wsChart = Nothing: Set wsData = Nothing
End SubRe,
Set rngChart = wsData.Cells(3, 1).CurrentRegion ' Attention!...
J'avais anticipé la chose avec le commentaire 'Attention!...'.
Bon, maintenant, il faut savoir ce que tu nommes tableau
Si le code modifié fonctionne, rien à redire.
Sinon, si il a une suite, tu joins un fichier.
Cdlt.
1/ La ligne où il y a attention? elle sert à quoi stp?
2/ Ben dès fois ça marche, et dès fois ça ne marche pas .... et je ne sais pas la raison.
cela demande un débogage là dessus quand ça ne fonctionne pas.
Set objChart = wsChart.ChartObjects.Add _
(Left:=wsChart.Columns("c").Left, _
Top:=wsChart.Rows(9).Top, _
Width:=600, _
Height:=250)C9 n'est pas une cellule fusionné au cas où...
Il y a une formule dans C9 si ça pose souci , je ne sais pas.
Re,
1 - Regarde l'aide VBA sur CurrentRegion (double clic sur CurrentRegion puis F1)
2 - Joins un fichier.
Cdlt.
Tout à l'air correct.
C'était un problème de protection de feuille. C'est tout.
Merci pour ton aide. J'ai profité de ton codes pour faire d'autres graphiques juste en histogramme par exemple et sans légende. Grâce à toi j'y suis arrivé.
Je te remercie très sincèrement.
Re,
Merci pour tes remerciements.
Il est parfois difficile de faire simple.
Cdlt.
J'ai fait des modifications dans mon tableau et du coup le code ne marche plus sauf si je supprime cela.
Set rngChart = wsData.Cells(3, 1).CurrentRegion ' Attention!...C'est grave de l'enlever vu que ça marche apparemment ?
Il y a dessous dans le code la plage de sélection exacte (ici de a1 à a31 et de f1 à F31) et elle restera toujours celle là.. Du coup le currentRegion ne me sert pas si? (j'ai fait des recherches sur le current region avant. je n'ai pas tout compris non plus j'avoue).
.SetSourceData Source:=Feuil241.Range("A1:A31,F1:F31")