Créer TCD base évolutive

Résolu/Fermé
ti_mouton Messages postés 143 Date d'inscription vendredi 29 mai 2015 Statut Membre Dernière intervention 5 septembre 2020 - 5 janv. 2017 à 16:24
ti_mouton Messages postés 143 Date d'inscription vendredi 29 mai 2015 Statut Membre Dernière intervention 5 septembre 2020 - 17 janv. 2017 à 12:25
Bonjour,

Je cherche à réutiliser ce code qui m'a été donné sur ce forum et qui fonctionnait très bien, pour l'adapter à un autre fichier mais je rencontre un blocage.

Sub CreerTCD1()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo GestionErreur
Sheets("globalJANVIER").Select
LigDeb = 1
DerLig = [A100000].End(xlUp).Row
ColDeb = 1
DerCol = [C1].End(xlToLeft).Column
Set DonneesSource = Range(Cells(LigDeb, ColDeb), Cells(DerLig, DerCol))
If Not Sheets("JANVIER") Is Nothing Then SupprimerLeTCDTRANSPORTEURS

CreationTCD:
Sheets("JANVIER").Tab.ColorIndex = 40

'utiliser l'enregistreur de macro pour la suite, puis coller ci-dessous
'puis dans la première ligne, remplacer les termes suivants par exemple:"SourceData:=B6:G30" par "SourceData:=DonneesSource"
'**********************************************************************************************************************************

Range("B2").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
DonneesSource, Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="JANVIER!R2C2", TableName:= _
"LeTCDTRANSPORTEURS", DefaultVersion:=xlPivotTableVersion15
With ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").PivotFields( _
"Transporteurs")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").AddDataField ActiveSheet. _
PivotTables("LeTCDTRANSPORTEURS").PivotFields( _
"Somme de Nombre de transport"), "Somme de Somme de Nombre de transport", xlSum
ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").AddDataField ActiveSheet. _
PivotTables("LeTCDTRANSPORTEURS").PivotFields("Somme de Km Parcourus"), _
"Somme de Somme de Km Parcourus", xlSum
Range("C2").Select
ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").DataPivotField.PivotItems( _
"Somme de Somme de Km Parcourus").Caption = "Km Parcourus"
Range("D2").Select
ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").DataPivotField.PivotItems( _
"Somme de Somme de Nombre de transport").Caption = "Nombre de transport"
Range("B2").Select
ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").CompactLayoutRowHeader = _
"Analyse Transports"
Range("B2").Select
'******************************************************************************************************************************************
Exit Sub
GestionErreur:
SupprimerLeTCDTRANSPORTEURS
On Error GoTo 0
On Error Resume Next
GoTo CreationTCD

End Sub
Sub SupprimerLeTCDTRANSPORTEURS()
On Error GoTo Sortie
Application.DisplayAlerts = False
With Sheets("JANVIER")
.Select
Set Plage = .Range(.Cells(2, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 4))
Plage.Clear
End With
Sortie:
End Sub


VBA m'indique une erreur à ce niveau du code
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
DonneesSource, Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="JANVIER!R2C2", TableName:= _
"LeTCDTRANSPORTEURS", DefaultVersion:=xlPivotTableVersion15


"erreur definie par l'application ou par l'objet"

Une idée pour m'aider ?

Merci :)


A voir également:

1 réponse

Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337
7 janv. 2017 à 08:39
Bonjour,
L'erreur ne vient pas de là, mais plutôt du fait qu'il ne peut pas effacer le TCD, il faut le supprimer pour le recréer à nouveau.
Dans votre cas, au départ, s'il détecte la feuille "JANVIER", le programme est redirigé vers la gestion d'erreur qui veut effacer le contenu de cette feuille, mais le TCD est toujours présent. A la sortie de la gestion d'erreur, on reprend le programme principal à l'étiquette "CreationTCD", et on lui demande de recréer le TCD, or comme celui-ci est toujours présent, cela crée une nouvelle erreur et comme la gestion d'erreur n'est pas réinitialisée, le programme plante sur la ligne de création du TCD.
Le plus simple est de supprimer le TCD existant et de le créer à nouveau.

ce qui donne à partir de l'étiquette:
CreationTCD:
    Sheets.Add.Name = "JANVIER"
    Sheets("JANVIER").Tab.ColorIndex = 40

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        DonneesSource, Version:=xlPivotTableVersion15). _
        CreatePivotTable TableDestination:="JANVIER!R2C2", TableName:= _
        "LeTCDTRANSPORTEURS", DefaultVersion:=xlPivotTableVersion15
    
    Sheets("JANVIER").Select
    Cells(3, 2).Select
    ActiveWorkbook.ShowPivotTableFieldList = True
    Range("B2").Select
    ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").AddDataField ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").PivotFields("Somme de Nombre de transport"), "Somme de Somme de Nombre de transport", xlSum
    ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").AddDataField ActiveSheet. _
        PivotTables("LeTCDTRANSPORTEURS").PivotFields("Somme de Km Parcourus"), "Somme de Somme de Km Parcourus", xlSum
    Range("C2").Select
    ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").DataPivotField.PivotItems("Somme de Somme de Km Parcourus").Caption = "Km Parcourus"
    Range("D2").Select
    ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").DataPivotField.PivotItems("Somme de Somme de Nombre de transport").Caption = "Nombre de transport"
    Range("B2").Select
    ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").CompactLayoutRowHeader = "Analyse Transports"
    Range("B2").Select
   '******************************************************************************************************************************************
Exit Sub
GestionErreur:
    SupprimerLeTCDTRANSPORTEURS
    On Error GoTo 0
    On Error Resume Next
    GoTo CreationTCD
End Sub

Sub SupprimerLeTCDTRANSPORTEURS()
    On Error GoTo Sortie
    Application.DisplayAlerts = False
    Sheets("JANVIER").Delete
Sortie:
End Sub


A tester
Cdlt
0
ti_mouton Messages postés 143 Date d'inscription vendredi 29 mai 2015 Statut Membre Dernière intervention 5 septembre 2020
Modifié par ti_mouton le 11/01/2017 à 17:34
Bonjour,

Merci pour votre réponse. Je viens de tester votre solution mais le code plante au niveai de la ligne
   ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").AddDataField ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").PivotFields("Somme de Nombre de transport"), "Somme de Somme de Nombre de transport", xlSum


avec le msg d'erreur suivant : Impossible de lire la propriété PivotFields de la classe PivotTable.

Sub TOTAL_JANV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo GestionErreur
Sheets("globalJANVIER").Select
LigDeb = 1
DerLig = [A100000].End(xlUp).Row
ColDeb = 1
DerCol = [C1].End(xlToLeft).Column
Set DonneesSource = Range(Cells(LigDeb, ColDeb), Cells(DerLig, DerCol))
If Not Sheets("JANVIER") Is Nothing Then SupprimerLeTCDTRANSPORTEURS

CreationTCD:
Sheets.Add.Name = "JANVIER"
Sheets("JANVIER").Tab.ColorIndex = 40

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
DonneesSource, Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="JANVIER!R2C2", TableName:= _
"LeTCDTRANSPORTEURS", DefaultVersion:=xlPivotTableVersion15

Sheets("JANVIER").Select
Cells(3, 2).Select
ActiveWorkbook.ShowPivotTableFieldList = True
Range("B2").Select
ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").AddDataField ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").PivotFields("Somme de Nombre de transport"), "Somme de Somme de Nombre de transport", xlSum
ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").AddDataField ActiveSheet. _
PivotTables("LeTCDTRANSPORTEURS").PivotFields("Somme de Km Parcourus"), "Somme de Somme de Km Parcourus", xlSum
Range("C2").Select
ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").DataPivotField.PivotItems("Somme de Somme de Km Parcourus").Caption = "Km Parcourus"
Range("D2").Select
ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").DataPivotField.PivotItems("Somme de Somme de Nombre de transport").Caption = "Nombre de transport"
Range("B2").Select
ActiveSheet.PivotTables("LeTCDTRANSPORTEURS").CompactLayoutRowHeader = "Analyse Transports"
Range("B2").Select

'******************************************************************************************************************************************
Exit Sub
GestionErreur:
SupprimerLeTCDTRANSPORTEURS
On Error GoTo 0
On Error Resume Next
GoTo CreationTCD
End Sub

Sub SupprimerLeTCDTRANSPORTEURS()
On Error GoTo Sortie
Application.DisplayAlerts = False
Sheets("JANVIER").Delete
Sortie:
End Sub


Merci pour votre aide
0
ti_mouton Messages postés 143 Date d'inscription vendredi 29 mai 2015 Statut Membre Dernière intervention 5 septembre 2020
11 janv. 2017 à 17:41
voici un lien vers une partie de mon fichier si ça peut aider http://www.cjoint.com/c/GAlqPqL3DfR
0
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337 > ti_mouton Messages postés 143 Date d'inscription vendredi 29 mai 2015 Statut Membre Dernière intervention 5 septembre 2020
13 janv. 2017 à 16:30
Bonjour
Désolé pour la réponse tardive, mais j'étais absent toute la semaine.
l'erreur viens de la détection de la dernière colonne du tableau.
pour le tableau de gauche, remplacez
DerCol = [C1].End(xlToLeft).Column

par
DerCol = [A1].End(xlToRight).Column

A tester
Cdlt
0
ti_mouton Messages postés 143 Date d'inscription vendredi 29 mai 2015 Statut Membre Dernière intervention 5 septembre 2020 > Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023
17 janv. 2017 à 12:25
Parfait ça fonctionne, Merci beaucoup !
0