Passage d'une procédure "classique" à une proc. de module ou une fonction

Question

Bonjour,

je suis toujours sur le même projet de création de graphiques sous VBA. Je dois créer 15 graphiques.
Voici comment je crée un des graphiques sous VBA, avec une procédure "classique", dans un userform.

ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select 'création graphique de tel type
With ActiveChart
.SetSourceData source:=Range("A7:H10") ', PlotBy:=xlRows 'sélection des données
.Parent.Name = "Gr1"
.ChartTitle.Text = "Répartition de la population par tranche d'âge"
.ChartTitle.Select
End With

Les éléments qui sont susceptibles de varier à chaque fois, selon le graphique que je souhaite créer, sont le style (ici "201"), le type (ici "xlColumnClustered"), les cellules sélectionnées (ici "A7:H10"), le "nom" du graphique (ici "Gr1") et son titre (ici "Répartition de la population par tranche d'âge").

D'habitude, je sais comment passer d'une procédure classique à une procédure de module ou un fonction mais je n'arrive pas à le faire ici, avec la création de graphiques… Sauriez-vous comment faire ?

Invité · Accepted Answer

Module de classe Dim Shap As Shape Enum Style ExlColumnClustered = xlColumnClustered ExlColumnStacked = xlColumnStacked ExlColumnStacked100 = xlColumnStacked100 Exl3DColumnClustered = xl3DColumnClustered Exl3DColumnStacked = xl3DColumnStacked Exl3DColumnStacked100 = xl3DColumnStacked100 Exl3DColumn = xl3DColumn ExlCylinderColClustered = xlCylinderColClustered ExlCylinderColStacked = xlCylinderColStacked ExlCylinderColStacked100 = xlCylinderColStacked100 ExlCylinderCol = xlCylinderCol ExlConeColClustered = xlConeColClustered ExlConeColStacked = xlConeColStacked ExlConeColStacked100 = xlConeColStacked100 ExlConeCol = xlConeCol ExlPyramidColClustered = xlPyramidColClustered ExlPyramidColStacked = xlPyramidColStacked ExlPyramidColStacked100 = xlPyramidColStacked100 ExlPyramidCol = xlPyramidCol ExlLine = xlLine ExlLineStacked = xlLineStacked ExlLineStacked100 = xlLineStacked100 ExlLineMarkers = xlLineMarkers ExlLineMarkersStacked = xlLineMarkersStacked ExlLineMarkersStacked100 = xlLineMarkersStacked100 Exl3DLine = xl3DLine ExlPie = xlPie ExlPieExploded = xlPieExploded ExlPieOfPie = xlPieOfPie ExlBarOfPie = xlBarOfPie Exl3DPie = xl3DPie Exl3DPieExplodede = xl3DPieExploded ExlBarClustered = xlBarClustered ExlBarStacked = xlBarStacked ExlBarStacked100 = xlBarStacked100 Exl3DBarClustered = xl3DBarClustered Exl3DBarStacked = xl3DBarStacked Exl3DBarStacked100 = xl3DBarStacked100 ExlCylinderBarClustered = xlCylinderBarClustered ExlCylinderBarStacked = xlCylinderBarStacked ExlCylinderBarStacked100 = xlCylinderBarStacked100 ExlConeBarClustered = xlConeBarClustered ExlConeBarStacked = xlConeBarStacked ExlConeBarStacked100 = xlConeBarStacked100 ExlPyramidBarClustered = xlPyramidBarClustered ExlPyramidBarStacked = xlPyramidBarStacked ExlPyramidBarStacked100 = xlPyramidBarStacked100 ExlArea = xlArea ExlAreaStacked = xlAreaStacked ExlAreaStacked100 = xlAreaStacked100 Exl3DArea = xl3DArea Exl3DAreaStacked = xl3DAreaStacked Exl3DAreaStacked100 = xl3DAreaStacked100 ExlXYScatter = xlXYScatter ExlXYScatterSmooth = xlXYScatterSmooth ExlXYScatterSmoothNoMarkers = xlXYScatterSmoothNoMarkers ExlXYScatterLines = xlXYScatterLines ExlXYScatterLinesNoMarkers = xlXYScatterLinesNoMarkers ExlDoughnut = xlDoughnut ExlDoughnutExploded = xlDoughnutExploded ExlBubble = xlBubble ExlBubble3DEffect = xlBubble3DEffect ExlRadar = xlRadar ExlRadarMarkers = xlRadarMarkers ExlRadarFilled = xlRadarFilled ExlSurface = xlSurface ExlSurfaceWireframe = xlSurfaceWireframe ExlSurfaceTopView = xlSurfaceTopView ExlSurfaceTopViewWireframe = xlSurfaceTopViewWireframe End Enum Public Sub SaveAs_Image(Feuille As Worksheet, Non As String, fichier As String) For Each MyObject In Feuille.Shapes If MyObject.Name = Non Then MyObject.Chart.Export Filename:=fichier, FilterName:="GIF" Exit Sub End If Next End Sub Public Sub Delete(Feuille As Worksheet, Non As String) For Each MyObject In Feuille.Shapes If MyObject.Name = Non Then MyObject.Delete: Exit Sub Next End Sub Public Sub Nouveau(Feuille As Worksheet, Non As String) Set Shap = Feuille.Shapes.AddChart Shap.Name = Non End Sub Public Sub Source(MyRange As Range, Orientation As Long) Shap.Chart.SetSourceData MyRange, Orientation End Sub Public Sub Style(MyStyle As Style) Shap.Chart.ChartType = MyStyle End Sub Public Sub SeriesCollection_Caption(Caption As String, Element As MsoChartElementType) Dim e Shap.Chart.SetElement Element Select Case Element Case 2 Shap.Chart.ChartTitle.Text = Caption Case 301 Shap.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Text = Caption Case 309 Shap.Chart.Axes(xlValue, xlPrimary).AxisTitle.Text = Caption End Select End Sub Public Sub SeriesCollection(V) Shap.Chart.SeriesCollection(1).XValues = V End Sub Public Sub SeriesCollection_Visible() Shap.Chart.SeriesCollection(1).ApplyDataLabels End Sub Public Sub Taille(Hauteur As Integer, Largeur As Integer) Shap.Height = Hauteur Shap.Width = Largeur End Sub Public Sub Position(X As Integer, Y As Integer) Shap.Top = X Shap.Left = Y End Sub Public Sub RenameSeries(Soruce As String, Cible As String) For Each s In Shap.Chart.SeriesCollection If s.Name = Soruce Then s.Name = Cible: Exit For Next End Sub Exemple d'utilisation! Sub test() Dim Plage As Range Dim Graph As New ClsGraph Set Plage = Range("$B$2:$D$35") Graph.Delete ActiveSheet, "Graph1" Graph.Nouveau ActiveSheet, "Graph1" Graph.Style ExlPyramidBarClustered Graph.Source Plage, xlRange Graph.SeriesCollection "=Recap!$B$2:$D$35" Graph.SeriesCollection_Caption "Mois", msoElementPrimaryCategoryAxisTitleAdjacentToAxis Graph.SeriesCollection_Caption "ETPs", msoElementPrimaryValueAxisTitleRotated Graph.SeriesCollection_Caption "Plan de charge Technique groupé par famille", msoElementChartTitleAboveChart Graph.RenameSeries "Série1", "TOTO" Graph.RenameSeries "Série2", "TITI" Graph.RenameSeries "Série3", "TUTU" Graph.Position 0, 200 Graph.Taille 400, 500 Graph.SeriesCollection_Visible Graph.SaveAs_Image ActiveSheet, "Graph1", ActiveWorkbook.Path & "\" & "graphe.gif" End Sub...

3GB · Answer

Je n'ai pas bien compris. Est-ce que vous parlez de procédure paramétrée : sub test() AjoutGraph activesheet, 201, 51, Range("A7:H10"), "Gr1", "Répartition de la population par tranche d'âge" end sub Sub AjoutGraph(Feuille as worksheet, Style as long, ChartType as long, Source as range, Name as string, Title as string) With Feuille.Shapes.AddChart2(Style, ChartType) 'création graphique de tel type .SetSourceData source:=Source .Parent.Name = Name &nbsp;&nbsp;&nbsp;&nbsp;.ChartTitle.Text = Title End With end sub Cdlt...

3GB · Answer

Je ne suis pas certain de bien vous comprendre, à cause d'un petit souci de terminologie j'imagine. Une fonction est censée renvoyer une valeur. Une fonction qui ne renvoie pas de valeur est l'équivalent d'une procédure. Je pense qu'il vous faut une procédure dépendant de paramètres, à placer dans un module standard. La méthode .addchart2 renvoie un objet Shape. Il faut donc utiliser la propriété .chart pour obtenir le graphique associé. Avec ce code, ça devrait mieux aller : private Sub Commandbutton1_Click() 'lancement au clic sur le bouton 1 ! dim i& For i = 1 To 15 AjoutGraph Sheets("Gr" & i), 201, 51, Sheets("Gr1").Range("$A$7:$H$10"), "Gr" & i & "bis", "Répartition de la population par tranche d'âge" Next i End Sub Sub AjoutGraph(Feuille As Worksheet, Style As Long, ChartType As Long, Source As Range, Name As String, Title As String) With Feuille.Shapes.AddChart2(Style, ChartType).chart .SetSourceData Source:=Source .Parent.Name = Name .ChartTitle.Text = Title End With End Sub Selon moi, cette façon de faire avec une boucle est la bonne. Le seul détail à régler est que la méthode .addchart2 attend potentiellement d'autres paramètres (notamment ceux qui définissent les dimensions du graphe) : https://docs.microsoft.com/fr-fr/office/vba/api/excel.shapes.addchart2 Pour l'instant, ceux-ci ont été négligés dans la procédure AjoutGraph. Cdlt...