TCD à utiliser sur différents fichiers

Bonjour à tous,

Alors voilà, je viens vous voir aujourd'hui car j'aurai vraiment besoin d'un programme, cependant il dépasse mon niveau d'apprenti à VBA. Je reçois chaque semaine un Plan de livraison (exemple en pièce jointe) qui contient une liste en général de plusieurs milliers de lignes avec des pièces à livrer. Sur chaque ligne il y a : la référence de la pièce, son nom, une date de livraison et une quantité.

Le soucis c'est que sur plusieurs milliers de lignes, c'est illisible... Donc j'ai recherché comment faire, et on m'a indiqué qu'il fallait utiliser les TCD : un super outil d'ailleurs, cependant le plan de livraison étant différent chaque semaine, il faut recréer le TCD toutes les semaines en rentrant correctement les bons paramètres, un enfer surtout que je ne maîtrise vraiment pas ces TCD !

J'ai pensé donc à un code qui permettrai à la réception de chaque plan de livraison, de créer automatiquement le TCD qui détaillerai sur les deux premières colonnes les références et désignations de chaque pièce, sur les colonnes suivantes les mois de l'année (janvier à décembre 2015), et qui donnerai une quantité totale à livrer pour chaque pièce à chaque mois.

J'ai observé sur le forum un sujet un peu similaire au miens : https://forum.excel-pratique.com/excel/soustotal-t63925.html, qui y détaillait un code vraiment pas mal pour mon problème (code ci-dessous). Cependant j'ai vraiment beaucoup de mal à le comprendre, et à essayer de l'adapter à mon soucis... J'ai déjà créé un classeur de macro personnel, je sais comment rajouter une icone pour pouvoir utiliser une macro dans n'importe quel autre fichier, il ne me reste "plus que" le code à adapter...

Si quelqu'un pouvait éventuellement m'aider sur cela, ce serait génial !

Je vous met également en pièce jointe le document vierge qui était donné dans le lien pour l'utilisation du code ci-dessous.

(PS : j'ai préféré poster mon soucis dans un autre sujet plutôt que de le mettre à la suite du sujet dont j'ai donné le mien, je ne sais pas si j'ai bien fait ou non)

Merci beaucoup,

Victorien

Option Explicit
'Option Private Module

Public Sub Traitement_Importation()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim lastCol As Long, lastRow As Long
Dim lo As ListObject
Dim ptCache As PivotCache
Dim pt As PivotTable
Dim CalcMode As XlCalculation

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets(1)
    With wsData
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        Set lo = wsData.ListObjects.Add(xlSrcRange, .Cells(1).Resize(lastRow, lastCol), , xlNo)
        With lo
            .Name = "tblImportation"
            .TableStyle = "TableStyleLight8"
        End With
    End With

    wb.Worksheets.Add After:=Worksheets(Worksheets.Count)
    Set wsPT = ActiveSheet
    ActiveSheet.Name = "TCD"

    With wsPT
        Set ptCache = wb.PivotCaches.Create(xlDatabase, lo.Range, 3)
        Set pt = ptCache.CreatePivotTable(.Cells(1), "PT_1", , 3)
        With pt
            .ManualUpdate = True
            With .PivotFields("Colonne2")
                .Orientation = xlRowField
               .Caption = "Mois"
            End With
            With .PivotFields("Colonne7")
                .Orientation = xlDataField
                .Position = 1
                .Function = xlSum
                .NumberFormat = "#,##0"
                .Caption = "Colonne7 "
            End With
            With .PivotFields("Colonne9")
                .Orientation = xlDataField
                .Position = 2
                .Function = xlSum
                .NumberFormat = "#,##0"
                .Caption = "Colonne9 "
            End With
           .ManualUpdate = False
            .ManualUpdate = True
            .PivotFields("Mois").LabelRange.Offset(1, 0).Group Start:=True, End:=True, _
                    Periods:=Array(False, False, False, False, True, False, False)
            .RowAxisLayout xlTabularRow
            .TableStyle2 = "PivotStyleMedium2"
            .ManualUpdate = False
        End With
    End With

    Application.Calculation = CalcMode

    Set pt = Nothing
    Set ptCache = Nothing
    Set lo = Nothing
    Set wsPT = Nothing: Set wsData = Nothing
    Set wb = Nothing

End Sub
13soustotal-5.zip (11.66 Ko)

Bonsoir,

Je veux bien intervenir, mais tu dois être précis dans ta demande.

Je ne comprends pas tout.

Cdlt.

Salut Jean-Eric,

Alors en fait je souhaiterais, lorsque je reçois caque semaine un nouveau plan de livraison (un nouveau fichier excel avec un tableau de pièces à livrer), pouvoir cliquer sur un raccourci (comme quand on clique sur enregistrer par exemple), qui me créée un TCD sur une nouvelle feuille dans le même fichier.

C'est le même principe que ce que tu avais fait dans le lien du cas que j'ai évoqué, sauf que le code est un peu différent puisque le TCD n'est pas exactement le même .

Je te met la forme du TCD que je souhaiterai obtenir en pièce jointe !

En te remerciant,

Victorien


voici aussi un "Plan de livraison" vierge comme j'en reçois chaque semaine.

Toujours bloqué sur ce problème, si quelqu’un aurait la gentillesse de ne serait-ce que m'aider un tout petit peu je lui en serait très reconnaissant....

Merci

Bonjour,

Désolé pour cet abandon (indépendant de ma volonté).

Je regarde ce jour.

Cdlt.

Bonjour Jean-Eric,

Aucun soucis à cela, désolé si je t'ai pressé par mon message.

J'attends la suite de tes instructions

Victorien

Bonsoir,

Peux-tu tester cette procédure dans ton environnement?

Pour ma part, à partir de tes données, j'ai une erreur lors du regroupement des dates (mois, année). Erreur que je ne comprends pas.

Cdlt.

Option Explicit
'Option Private Module

Public Sub Traitement_Importation()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim lastCol As Long, lastRow As Long
Dim lo As ListObject
Dim ptCache As PivotCache
Dim pt As PivotTable
Dim pf As PivotField
Dim CalcMode As XlCalculation

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets(1)
    With wsData
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        Set lo = wsData.ListObjects.Add(xlSrcRange, .Cells(1).Resize(lastRow, lastCol), , xlYes)
        With lo
            .Name = "tblImportation"
            .TableStyle = "TableStyleLight8"
        End With
    End With

    wb.Worksheets.Add After:=Worksheets(Worksheets.Count)
    Set wsPT = ActiveSheet
    ActiveSheet.Name = "TCD"

    With wsPT
        Set ptCache = wb.PivotCaches.Create(xlDatabase, lo.Range, 4)
        Set pt = ptCache.CreatePivotTable(.Cells(1), "PT_1", , 4)
        With pt
            .ManualUpdate = True
            .AddFields RowFields:=Array("Article", "Description"), _
                    ColumnFields:="Date livraison"
            With .PivotFields("Quantité ouverte")
                .Orientation = xlDataField
                .Function = xlSum
                .NumberFormat = "#,##0"
                .Caption = ChrW(931) & " Quantité ouverte"
            End With
            .ManualUpdate = False
            .ManualUpdate = True
        End With

        For Each pf In pt.PivotFields
            pf.Subtotals(1) = True
            pf.Subtotals(1) = False
        Next pf

        With pt
            .PivotFields("Date livraison").LabelRange.Offset(1, 0).Group Start:=True, End:=True, _
                    Periods:=Array(False, False, False, False, True, False, False)
            .RowAxisLayout xlTabularRow
            .TableStyle2 = "PivotStyleMedium8"
            .ColumnGrand = True
            .RowGrand = True
            .ManualUpdate = False
        End With
    End With

    Application.Calculation = CalcMode

    Set pt = Nothing
    Set ptCache = Nothing
    Set lo = Nothing
    Set wsPT = Nothing: Set wsData = Nothing
    Set wb = Nothing

End Sub

Bonjour Jean-Eric,

Je viens de tester et lorsque je lance le code, il m'affiche une erreur "La méthode AddFields de la classe PivotTable a échoué", et le débogueur me surligne la ligne :

Option Explicit
'Option Private Module

Public Sub Traitement_Importation()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim lastCol As Long, lastRow As Long
Dim lo As ListObject
Dim ptCache As PivotCache
Dim pt As PivotTable
Dim pf As PivotField
Dim CalcMode As XlCalculation

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets(1)
    With wsData
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        Set lo = wsData.ListObjects.Add(xlSrcRange, .Cells(1).Resize(lastRow, lastCol), , xlYes)
        With lo
            .Name = "tblImportation"
            .TableStyle = "TableStyleLight8"
        End With
    End With

    wb.Worksheets.Add After:=Worksheets(Worksheets.Count)
    Set wsPT = ActiveSheet
    ActiveSheet.Name = "TCD"

    With wsPT
        Set ptCache = wb.PivotCaches.Create(xlDatabase, lo.Range, 4)
        Set pt = ptCache.CreatePivotTable(.Cells(1), "PT_1", , 4)
        With pt
            .ManualUpdate = True
           .AddFields RowFields:=Array("Article", "Description"),
                    ColumnFields:="Date livraison"
            With .PivotFields("Quantité ouverte")
                .Orientation = xlDataField
                .Function = xlSum
                .NumberFormat = "#,##0"
                .Caption = ChrW(931) & " Quantité ouverte"
            End With
            .ManualUpdate = False
            .ManualUpdate = True
        End With

        For Each pf In pt.PivotFields
            pf.Subtotals(1) = True
            pf.Subtotals(1) = False
        Next pf

        With pt
            .PivotFields("Date livraison").LabelRange.Offset(1, 0).Group Start:=True, End:=True, _
                    Periods:=Array(False, False, False, False, True, False, False)
            .RowAxisLayout xlTabularRow
            .TableStyle2 = "PivotStyleMedium8"
            .ColumnGrand = True
            .RowGrand = True
            .ManualUpdate = False
        End With
    End With

    Application.Calculation = CalcMode

    Set pt = Nothing
    Set ptCache = Nothing
    Set lo = Nothing
    Set wsPT = Nothing: Set wsData = Nothing
    Set wb = Nothing

End Sub

Bonjour,

Assure-toi que les noms des champs de tes données (feuille de calcul) correspondent bien aux libellés des champs (pivotfields) dans le code VBA.

A te relire.

Cdlt.

Je viens de le faire, ils étaient exactement similaires, alors j'ai essayé de copier coller à partir du code et ça marche, bizarre mais bon quand même !

Maintenant c'est la ligne

With pt
            .PivotFields("Date livraison").LabelRange.Offset(1, 0).Group Start:=True, End:=True, _
                    Periods:=Array(False, False, False, False, True, False, False)
            .RowAxisLayout xlTabularRow
            .TableStyle2 = "PivotStyleMedium8"
            .ColumnGrand = True
            .RowGrand = True
            .ManualUpdate = False
        End With

qui ne fonctionne pas...

Re,

C'est bien ce que j'ai écrit précédemment.

Peux-tu me joindre un plan de livraison tel que tu le reçois, brut de fonderie?

Cdlt.

Voilà un plan de livraison brut comme demandé

Re,

A tester et me redire.

Cdlt.

Option Explicit
'Option Private Module

Public Sub Traitement_Importation()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim lastCol As Long, lastRow As Long
Dim rngData As Range
Dim ptCache As PivotCache
Dim pt As PivotTable
Dim pf As PivotField
Dim CalcMode As XlCalculation

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets(1)

    On Error Resume Next
    wb.Worksheets("TCD").Delete
    On Error GoTo 0

    Application.DisplayAlerts = True

    With wsData
        ' conversion des données Quantité ouverte
        .Columns(6).TextToColumns _
                Destination:=Range("F1"), _
                DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, _
                FieldInfo:=Array(1, 1), _
                DecimalSeparator:="."
        lastCol = 10
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        ' plage des données source du TCD à créer
        Set rngData = .Cells(1).Resize(lastRow, lastCol)
    End With

    wb.Worksheets.Add After:=Worksheets(Worksheets.Count)
    Set wsPT = ActiveSheet
    ActiveSheet.Name = "TCD"

    With wsPT
        ' création TCD
        Set ptCache = wb.PivotCaches.Create(xlDatabase, rngData, 4)
        Set pt = ptCache.CreatePivotTable(.Cells(1), "PT_1", , 4)
        With pt
            .ManualUpdate = True
            .AddFields RowFields:=Array("Article", "Description"), _
                    ColumnFields:="Date livraison"
            With .PivotFields("Quantité ouverte")
                .Orientation = xlDataField
                .Function = xlSum
                .NumberFormat = "#,##0"
                .Caption = ChrW(931) & " Quantité ouverte"
            End With
        End With
        ' pas de sous-totaux
        For Each pf In pt.PivotFields
            pf.Subtotals(1) = True
            pf.Subtotals(1) = False
        Next pf
        ' mise en forme TCD
        With pt
            .RowAxisLayout xlTabularRow
            .TableStyle2 = "PivotStyleMedium8"
            .ColumnGrand = True
            .RowGrand = True
            .ManualUpdate = False
        End With
        ' données groupées par mois et années
        pt.PivotFields("Date livraison").LabelRange.Offset(1, 0).Group Start:=True, End:=True, _
                Periods:=Array(False, False, False, False, True, False, True)
    End With

    Application.Calculation = CalcMode

    Set pt = Nothing
    Set ptCache = Nothing
    Set rngData = Nothing
    Set wsPT = Nothing: Set wsData = Nothing
    Set wb = Nothing

End Sub

Re Jean-Eric,

J'ai juste envie de dire : M-A-G-N-I-F-I-Q-U-E !!!!!

Derniers petits détails, est-ce qu'il serait possible à la place de la clonne totale de mettre 3 colonnes totales ? Une pour 2014, une pour 2015, et une pour 2016 ? Si non ce n'est pas grave, c'est juste pour une meilleure lisibilité !

En tout cas merci beaucoup pour tout ce boulot, c'est excellent !


Rectification, je viens de me rendre compte que lorsque je réduit 2014 ou 2015, à la place s'affiche le total que je souhaitais !

Mais comment pourrait-on marquer une séparation un peu plus marquante (bordure foncée, ou colorée) entre les colonnes des années ?

Re,

Ajoute la partie surlignée au code :

pt.PivotFields("Date livraison").LabelRange.Offset(1, 0).Group Start:=True, End:=True, _
                Periods:=Array(False, False, False, False, True, False, True)
        pt.PivotFields("Années").Subtotals(1) = True

Niquel ! Et comment est-ce que je pourrais juste récupérer "l'adresse" de ces colonnes total pour pouvoir en changer la couleur et les bordures ?

Bonjour,

Tu as le choix de plusieurs styles de TCDs, et tu peux en créer de nouveaux.

Fais des essais avec l'enregistreur de macros.

Cdlt.

Bonjour,

Effectivement, désolé je n'avais pas vu qu'il en existait plusieurs types

En tout cas merci beaucoup pour tout ton investissement, c'était vraiment très gentil de ta part, ce fichier va grandement m'aider !

Bonne journée

Bonjour,

Merci pour tes remerciements.

Tu reviens quand tu veux...

Cdlt.

Bonjour jean-Eric,

Je me permet de déterrer le sujet, puisque dans le cadre de mon projet j'aurais besoin d'une petite variante du TCD, ainsi qu'une modification si possible sur le TCD actuel.

- Il faudrait que les totaux déterminés sur une année soient calculés sur une saison de production, je m'explique : j'aurais besoin qu'au lieu de découper en année Janvier-Décembre, les années soient découpées de Septembre à Août.

Par exemple la saison de production actuelle était de Septembre 2014 à Août 2015, et il aurait été plus simple d'avoir le total sur la saison en cours que les totaux sur 2014, 2015, et 2016. Enfin si cela n'est pas possible ou trop difficile à effectuer ce n'est pas le plus important, la phase suivante l'est plus.

- J'aurais besoin d'une variante de ce TCD : il me faudrait un total des pièces à effectuer si possible sur deux semaines, plutôt que sur un mois complet. par exemple il serait vraiment pratique d'avoir une colonne de détail des nombres de pièces à livrer du 1er au 15 Juin, ainsi qu'une colonne juste à côté du 15 au 30 Juin, plutôt qu'une seule colonne actuelle pour toutes les quantités en Juin.

Dans une premier temps je ne sais pas si cela est possible, ou peut-être qu'il est plus judicieux de faire un détail sur les semaines 1, 2 , 3 ,4 de chaque semaine ? En tout cas cela est pour gérer la production avec les deux tableaux en même temps (détail de semaine, et total au mois) !

Je reste connecté pour te répondre si jamais tout cela n'est pas très clair ou si jamais tu as d'autres interrogations. Dans le besoin je pourrais te donner une "image" de ce dont j'aurais besoin pour qu'éventuellement ce te soit plus clair

En te remerciant d'avance,

Victorien

Rechercher des sujets similaires à "tcd utiliser differents fichiers"