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.

image

Merci de votre aide

14graph.xlsm (72.67 Ko)

Bonjour Fronck,

Comme ça un peu à l'arrache en tenant compte du fait qu'il peut y avoir plus de noms et de mois

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.

12graph.xlsm (82.15 Ko)
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 mais pour répondre au besoin du demandeur

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

un truc pour des tables croisées, quand on a un layout favorable, on peut sauvegarder cela avec

"bestand>opties>gegevens (Fichier>Options>données ???)

schermafbeelding 2022 05 02 163654
Rechercher des sujets similaires à "graphique vba"