XL 2016 Création de tableau dynamique croisé

VBA · 25 Avril 2018

Bonjour,
J'ai développer un code pour selectionner les données d'un excel et les met en forme dans un tableau dynamique croisé, mais j'ai une erreur au niveau du nom a chaque fois.
Pouvez vous m'aider svp ?

Voici mon code

VB:

Sub TCD_échéancier()

    Der = ActiveSheet.Cells(Rows.count, "A").End(xlUp).Row

For i = 2 To Der
    If Range("M" & i) = 0 Then
        Rows(i).Insert
        Exit For
    End If
Next

    Range("A1:N1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Feuil1!R1C1:R" & i - 1 & "C14", Version:=6).CreatePivotTable TableDestination:= _
        "Feuil2!R3C1", TableName:="Tableau croisé dynamique1", DefaultVersion:=6
    Sheets("Feuil2").Select

    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "FER MON")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Article" _
        )
        .Orientation = xlDataField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Domaine" _
        )
        .Orientation = xlRowField
        .Position = 2
    End With

    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Semaine échéancier")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Reste a livr.")
        .Orientation = xlPageField
        .Position = 1
    End With



End Sub

J'ai aperçu sur le net de mettre sous un tableau et insérer ensuite le TCD. Mias je ne vois pas vraiment comment sa marche.
D'avance merci.

MJ13 · 4 Mai 2018

Bonjour à tous

J'ai testé ton code du #6 sur le fichier avec Excel 2016 (version Office 365) et je n'ai pas eu de bugs.

VBA · 4 Mai 2018

C'est bizarre après mainte essais sa m'affiche toujour la même erreur

Staple1600 · 4 Mai 2018

Bonjour le fil, le forum

@VBA
Si tu testes (avec cette macro modifiée) sur toutes les données, est-ce que le TCD se fait bien sans erreur?
(Chez moi, oui test OK sans bug)

VB:

Sub test()
Dim Plg As Range, Nom_TCD
Set Plg = Feuil1.Range("A1").CurrentRegion
Nom_TCD = InputBox("Nom du TCD?", "TCD", "TCD_N" & Second(Time))
ActiveWorkbook.PivotCaches.Add(SourceType:=1, _
     SourceData:=Plg).CreatePivotTable TableDestination:="", _
     TableName:=CStr(Nom_TCD), DefaultVersion:=1
With ActiveSheet
.PivotTableWizard TableDestination:=.Cells(1, 1)
With .PivotTables(CStr(Nom_TCD))
     With .PivotFields("Division")
         .Orientation = xlRowField
         .Position = 1
    End With
    With .PivotFields("Article")
         .Orientation = xlDataField
         .Position = 1
    End With
    With .PivotFields("Mag.")
         .Orientation = xlRowField
         .Position = 2
    End With
End With
End With
End Sub

VBA · 4 Mai 2018

Toujours cette erreur

MJ13 · 4 Mai 2018

Re

Il faudrait aussi donner ta version d'Excel.

Sinon, la plage semble être mauvaise, vu que l'erreur dit qu'il faut au moins 2 lignes. Tu peux définir un nom pour ta plage et la mettre en dur dans le code pour tester.

Avec Excel, au plus tu fais simple au départ et au plus cela fonctionne. Tu peux aussi utiliser l'enregistreur de macros pour voir le code généré.

VBA · 4 Mai 2018

Je suis sur Excel 2016, j'ai deja testé d'entré en dur la plage mais rien n'y fait tjr la même erreur.

VB:

Set Plg = Feuil1.Range("A1:T" & j - 1)

j-1 c'est la derniere ligne non vide

Staple1600 · 4 Mai 2018

Re, Bonjour MJ13

@VBA
j'ai testé à partir de ton fichier exemple joint pourtant
(sauf qu'actuellment je teste sur un Excel 2003)
Et avec cette version (en testant sur ton fichier exemple mais pas sur ton fichier réel)
Chez moi pas de bug.

VB:

Sub test2() ' test ok
Dim PTCache As PivotCache, PT As PivotTable
menage
'création du "cache"
Set PTCache = _
    ActiveWorkbook.PivotCaches.Add(1, Sheets(1).Cells(1).CurrentRegion)
'création feuille recevant le TCD
Worksheets.Add
'création et agencement du TCD
Set PT = ActiveSheet.PivotTables.Add(PTCache, Cells(3))
    With PT
        With .PivotFields("Article")
            .Orientation = 4: .Position = 1
        End With
        With .PivotFields("Division")
            .Orientation = 1: .Position = 1
        End With
        With .PivotFields("Mag.")
            .Orientation = 1: .Position = 2
        End With
    End With
End Sub
Private Sub menage()
Dim sht As Worksheet
With Application
    .ScreenUpdating = 0: .DisplayAlerts = 0
    For Each sht In ActiveWorkbook.Sheets
        If Not sht.Name = "Feuil1" Then
            sht.Delete
        End If
    Next
    .DisplayAlerts = -1: .ScreenUpdating = -1
End With
End Sub

VBA · 4 Mai 2018

Sa fonctionne cette fois, mais dans les pivotfields c'est l'option .Orientation qui définit si c'est dans le rowfield ou datafield quil faut placer les données pour la construction du tcd ? Je voudrais savoir sa pour pouvoir l'appliquer sur d'autre fichier également.

Staple1600 · 4 Mai 2018

Re

Une version simplifiée
(Nécessite l'existence d'une feuille nommée TCD avant éxécution de la macro)
(test OK à partir de tes données du fichier exemple, sur Excel 2003)

VB:

Sub test_3()
Dim PTCache As PivotCache, PT As PivotTable, rng As Range
Sheets("TCD").PivotTables(1).TableRange2.Clear
Set rng = Worksheets("Feuil1").UsedRange
Set PTCache = ActiveWorkbook.PivotCaches.Add(1, rng)
Set PT = Sheets("TCD").PivotTables.Add(PTCache, Sheets("TCD").Cells(3))
With PT
        With .PivotFields("Article")
            .Orientation = 4: .Position = 1
        End With
        With .PivotFields("Division")
            .Orientation = 1: .Position = 1
        End With
        With .PivotFields("Mag.")
            .Orientation = 1: .Position = 2
        End With
    End With
End Sub

NB: Pour les propriétés Orientation/Position, j'ai remplacé les valeurs par leur constante
(voir pour plus dans l'aide VBE, touche F1, ou sur le web)

VBA · 4 Mai 2018

Celle d'avant me va très bien merci bcp @Staple1600

Staple1600 · 4 Mai 2018

Re

@VBA
Personnellement, je trouve test_3 plus "propre"
(La précédente ajoute une feuille pour créer un TCD puis supprime toutes les feuilles sauf la feuille 1 avant de nouveau récréer un nouvelle feuille pour un nouveau TCD)
test_3 se contente se supprimer le TCD existant sur la feuille nommée TCD puis en crée un nouveau sur la feuille nommée TCD.

VBA · 4 Mai 2018

En fin de compte la deuxième méthode est mieu. Je suis d'accord avec toi.

Staple1600 · 4 Mai 2018

Re

@VBA
Une dernière suggestion
Tu ne lances qu'un seule fois la macro: Creation_TCD
Ensuite si tes données sont ajoutés sur la feuille nommée Feuil1
tu lances la macro rafraichir_tcd pour rafraichir et actualiser le TCD

VB:

Dim PTCache As PivotCache
Dim PT As PivotTable
Sub Creation_TCD()
Dim rng As Range
Set rng = Worksheets("Feuil1").UsedRange
Set PTCache = ActiveWorkbook.PivotCaches.Add(1, rng)
Set PT = Sheets("TCD").PivotTables.Add(PTCache, Sheets("TCD").Cells(3))
With PT
        With .PivotFields("Article")
            .Orientation = 4: .Position = 1
        End With
        With .PivotFields("Division")
            .Orientation = 1: .Position = 1
        End With
        With .PivotFields("Mag.")
            .Orientation = 1: .Position = 2
        End With
    End With
End Sub
Sub rafraichir_tcd()
Dim rng As Range
Set rng = Worksheets("Feuil1").UsedRange
Set PTCache = ActiveWorkbook.PivotCaches.Add(1, rng)
Sheets("TCD").PivotTables(1).PivotCache.Refresh
End Sub

VBA · 4 Mai 2018

La maccro sera lancé qu'une seul fois par fichier si aucun soucis ne se présente.
Mais elle va être adapté et utilisé pour plusieurs fichier différent.

Staple1600 · 4 Mai 2018

Re,

@VBA
Dans mon précédent message, il y a deux macros pas une

XL 2016 Création de tableau dynamique croisé

VBA

XLDnaute Nouveau

MJ13

XLDnaute Barbatruc

VBA

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

VBA

XLDnaute Nouveau

MJ13

XLDnaute Barbatruc

VBA

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

VBA

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

VBA

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

VBA

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

VBA

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Discussions similaires