Graphique en VBA
Bonjour à tous,
Aprés avoir enregistré une macro pour faire ce graphique croisé dynamique, j'aurais besoin de mettre les noms de cet exemple sous forme de variable pour la prochaine classe d'école ou matiére ou je répèterais l'opération.
Il y a aussi les renommages des champs "somme de sept" en "notes de sept", faits en enregistrement macro, qui buggent.
Merci de votre aide
Bonjour Fronck,
Comme ça un peu à l'arrache
Sub CréationGraph()
Dim dCol As Long, dLig As Long
Dim SceD As String
Dim SlIt As SlicerItem
' Adresse de la plage source
With ActiveSheet
dCol = .Cells(1, Columns.Count).End(xlToLeft).Column
dLig = .Range("A" & Rows.Count).End(xlUp).Row
SceD = "test!" & .Range(.Cells(1, 1), .Cells(dLig, dCol)).Address
End With
' Création du TCD
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
SceD, Version:=7).CreatePivotTable TableDestination:= _
"test!R" & dLig + 2 & "C2", TableName:="TCD1", DefaultVersion:=7
ActiveWorkbook.ShowPivotTableFieldList = True
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("test!$B$" & dLig + 2 & ":$E$" & dLig + 2)
With ActiveChart.PivotLayout.PivotTable.PivotFields("Nom")
.Orientation = xlRowField
.Position = 1
End With
With ActiveChart.PivotLayout.PivotTable.PivotFields("Nom")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveChart
With .PivotLayout.PivotTable
.AddDataField ActiveChart.PivotLayout.PivotTable.PivotFields("sept"), "Notes de sept", xlSum
.AddDataField ActiveChart.PivotLayout.PivotTable.PivotFields("oct"), "Notes de oct", xlSum
.AddDataField ActiveChart.PivotLayout.PivotTable.PivotFields("nov"), "Notes de nov", xlSum
.AddDataField ActiveChart.PivotLayout.PivotTable.PivotFields("déc"), "Notes de déc", xlSum
.AddDataField ActiveChart.PivotLayout.PivotTable.PivotFields("jvier"), "Notes de jvier", xlSum
.AddDataField ActiveChart.PivotLayout.PivotTable.PivotFields("fév"), "Notes de fév", xlSum
.AddDataField ActiveChart.PivotLayout.PivotTable.PivotFields("mar"), "Notes de mar", xlSum
.AddDataField ActiveChart.PivotLayout.PivotTable.PivotFields("avr"), "Notes de avr", xlSum
With .DataPivotField
.Orientation = xlRowField
.Position = 1
End With
End With
.ChartType = xlLineMarkers
End With
'.PlotArea.Select
'.ChartArea.Select
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.PivotTables("TCD1"), "Nom").Slicers.Add _
ActiveSheet, , "Nom", "Nom", 74.25, 300.75, 144, 198.75
ActiveSheet.Shapes.Range(Array("Nom")).Select
ActiveSheet.Shapes("Nom").IncrementLeft 217.5
ActiveSheet.Shapes("Nom").IncrementTop 2.25
With ActiveWorkbook.SlicerCaches("Segment_Nom")
For Each SlIt In .SlicerItems
SlIt.Selected = True
Next SlIt
End With
ActiveCell.Columns("C:H").ColumnWidth = 6.43
End Sub
A+
Bonjour à tous,
Un peu de concurrence.
A adapter !...
Cdlt.
Option Explicit
Public Sub CreatePivotChart()
Dim wb As Workbook
Dim wsData As Worksheet
Dim PTCache As PivotCache, PT As PivotTable
Dim SLCache As SlicerCache, SL As Slicer
Dim rngData As Range, rngChart As Range
Dim objChart As ChartObject
Dim lCol As Long, lCols As Long, lRows As Long
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set wsData = wb.Worksheets(1)
On Error Resume Next
With wb.Worksheets(1)
.PivotTables(1).TableRange2.Clear
.ChartObjects(1).Delete
.Shapes.Range(Array("NomSlicerCache")).Delete
End With
On Error GoTo 0
With wsData
lCols = .Cells(1, Columns.Count).End(xlToLeft).Column
lRows = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngData = .Cells(1).Resize(lRows, lCols)
End With
Set PTCache = wb.PivotCaches.Create(xlDatabase, rngData)
Set PT = PTCache.CreatePivotTable(wsData.Cells(15, 2), "PT_1")
With PT
.ManualUpdate = True
.AddFields ColumnFields:="Nom"
For lCol = 3 To lCols
With .PivotFields(lCol)
.Orientation = xlDataField
.Position = lCol - 2
.Function = xlSum
.NumberFormat = "0.00"
.Caption = .SourceName & " "
End With
Next lCol
.DataPivotField.Orientation = xlRowField
.DisplayFieldCaptions = False
.TableStyle2 = "PivotStyleLight1"
.ManualUpdate = False
End With
Set SLCache = wb.SlicerCaches.Add2(PT, "Nom", "NomSlicerCache")
Set SL = SLCache.Slicers.Add(wsData, , "NomSlicerCache", "Sélectionner le(s) nom(s)", wsData.Cells(15, 10).Top, wsData.Cells(15, 10).Left)
With SL
.Width = 178
.Style = "SlicerStyleOther1"
End With
Set rngChart = PT.TableRange2
Set objChart = wb.Worksheets(1).ChartObjects.Add(100, 200, 400, 250)
objChart.Name = "PG_1"
With objChart.Chart
.SetSourceData Source:=rngChart
.ChartType = xlLineMarkers
.ShowAllFieldButtons = False
End With
End Sub
bonjour,
j'ai toujours des questions sur des macros qui créent des pivottables. On utilise cela une fois, dans ce temps, on sait tout faire en manuel. Créer un macro pour adapter le layout après un refresh, ça !!! ça vaut le coup !
Bonjour BsAlv
bonjour,
j'ai toujours des questions sur des macros qui créent des pivottables. On utilise cela une fois, dans ce temps, on sait tout faire en manuel. Créer un macro pour adapter le layout après un refresh, ça !!! ça vaut le coup !
Il suffit de lire l'intitulé de la demande
Extrait : "pour la prochaine classe d'école ou matière ou je répèterais l'opération"
Voilà
Re,
@BsAlv,
Un exemple retrouvé dans mes archives (pas tout à fait optimisé de mémoire). J'ai dû supprimer le final.
Pourquoi des TCDs en VBA ?
Cdlt.
d'accord, mais moi, je préfères de créer un tableau croisé et un fois, jouez avec cela.
Autre école ou données = changer la source et "refresh"
autre manière de presentation = changer le layout.
L'effort de créer le tableau croisé avec un macro n'est pas efficase.
@BsAlv,
Nous ne sommes pas là pour dire ce que nous préférons
Intervention inutile donc.
Bonjour à tous,
Merci à Bruno et Jean-Eric, vos 2 solutions marchent bien.
J'y ai rajouté la matiére dans le titre.
@jean-eric
Pourquoi des TCDs en VBA ?
J'ai oublié qu'un refresh pouvait s'adapter à une autre matiére ou classe, mais si on a une classe de 15 puis 30 éléves la macro se justifie pour une position adéquate.
Merci bcp
Bonjour,
@fronck,
Ma remarque était pour BsAlv.
Cdlt.
Bonsoir à tous,
Pas si simple de changer de fichier, mais c'est bon