Créer TCD base évolutive Résolu

Question

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 :)
Configuration: Windows 7 / Mozilla 11.0

Frenchie83 · Answer

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

Créer TCD base évolutive

1 réponse

Discussions similaires

Newsletters