VBA ajout élément dans plusieurs tableaux croisés dynamiques

[nico91410]

Salut,

Je vous explique mon problème, chaque semaine, je dois mettre à jour une trentaine de tableaux croisés dynamiques, la mise à jour consiste uniquement :
- à ajouter la semaine dans le champ valeurs (pour un type de TCD)
- à supprimer l'ancienne semaine puis à ajouter la nouvel (dans un autre type de TDC).

Je ne suis pas très fort en VBA, mais j'ai réussi à faire quelque chose mais pour une semaine donnée.
Comment faire pour qu'une boite de dialogue s'ouvre, j'indique le numéro de la semaine à mettre à jour, je valide et cela ajoute la semaine inscrite dans tous mes TCD.

Voici ma macro (déjà elle fonctionne )

Sub Test_MAJ_SEMAINE()

Dim Ind, Ind1, Inde As Integer

'Mettre à jour la semaine pour TCD évolution des sites L
For Ind = 1 To 11
Sheets("Alertes").PivotTables("Tableau croisé dynamiqueg" & Ind).AddDataField _
Sheets("Alertes").PivotTables("Tableau croisé dynamiqueg" & Ind).PivotFields("S25"), "Nombre de S25", _
xlCount
With Sheets("Alertes").PivotTables("Tableau croisé dynamiqueg" & Ind).PivotFields( _
"Nombre de S25")
.Caption = "S25 "
.Function = xlSum
End With
Next Ind

'Mettre à jour la semaine pour TCD à date des sites L
For Ind1 = 1 To 11
Sheets("Alertes").PivotTables("Tableau croisé dynamiques" & Ind1).PivotFields( _
"Somme de S24").Orientation = xlHidden
Sheets("Alertes").PivotTables("Tableau croisé dynamiques" & Ind1).AddDataField Sheets("Alertes"). _
PivotTables("Tableau croisé dynamiques" & Ind1).PivotFields("S25"), "Nombre de S25", _
xlCount
With Sheets("Alertes").PivotTables("Tableau croisé dynamiques" & Ind1).PivotFields( _
"Nombre de S25")
.Caption = "S25 "
.Function = xlSum
End With
Next Ind1

'Mettre à jour la semaine pour TCD des sites E
For Inde = 1 To 4
Sheets("Alertes Ext").PivotTables("Tableau croisé dynamiquee" & Inde).AddDataField _
Sheets("Alertes Ext").PivotTables("Tableau croisé dynamiquee" & Inde).PivotFields("S25"), "Nombre de S25", _
xlCount
With Sheets("Alertes Ext").PivotTables("Tableau croisé dynamiquee" & Inde).PivotFields( _
"Nombre de S25")
.Caption = "S25 "
.Function = xlSum
End With
Next Inde


End Sub

(pour info aussi, comment mettre la macro dans un champ spécial dans un message de forum)

Merci d'avance.

 

[JCGL]

Re : VBA ajout élément dans plusieurs tableaux croisés dynamiques

Bonjour à tous,

Peux-tu essayer :

Option Explicit


Sub Test_MAJ_SEMAINE()


    Dim Ind, Ind1, Inde As Integer
    Dim Rep As String


    Rep = InputBox("Pour quelle semaine ?", "Semaine", "Sxx")


    'Mettre à jour la semaine pour TCD évolution des sites L
    For Ind = 1 To 11
        Sheets("Alertes").PivotTables("Tableau croisé dynamiqueg" & Ind).AddDataField _
                Sheets("Alertes").PivotTables("Tableau croisé dynamiqueg" & Ind).PivotFields(Rep), "Nombre de " & Rep, xlCount
        With Sheets("Alertes").PivotTables("Tableau croisé dynamiqueg" & Ind).PivotFields( _
             "Nombre de " & Rep)
            .Caption = "S25 "
            .Function = xlSum
        End With
    Next Ind


    'Mettre à jour la semaine pour TCD à date des sites L
    For Ind1 = 1 To 11
        Sheets("Alertes").PivotTables("Tableau croisé dynamiques" & Ind1).PivotFields( _
                "Somme de S24").Orientation = xlHidden
        Sheets("Alertes").PivotTables("Tableau croisé dynamiques" & Ind1).AddDataField Sheets("Alertes"). _
                                                                                       PivotTables("Tableau croisé dynamiques" & Ind1).PivotFields(Rep), "Nombre de " & Rep, xlCount
        With Sheets("Alertes").PivotTables("Tableau croisé dynamiques" & Ind1).PivotFields( _
             "Nombre de " & Rep)
            .Caption = "S25 "
            .Function = xlSum
        End With
    Next Ind1


    'Mettre à jour la semaine pour TCD des sites E
    For Inde = 1 To 4
        Sheets("Alertes Ext").PivotTables("Tableau croisé dynamiquee" & Inde).AddDataField _
                Sheets("Alertes Ext").PivotTables("Tableau croisé dynamiquee" & Inde).PivotFields(Rep), "Nombre de " & Rep, xlCount
        With Sheets("Alertes Ext").PivotTables("Tableau croisé dynamiquee" & Inde).PivotFields( _
             "Nombre de " & Rep)
            .Caption = "S25 "
            .Function = xlSum
        End With
    Next Inde
End Sub

Evidemment pas tester...

A+ à tous

 

[nico91410]

Re : VBA ajout élément dans plusieurs tableaux croisés dynamiques

Super ça fonctionne sauf pour le deuxième type de TCD.
Car sur la partie en gras, il faut enlever le paramètre Somme de (Sxx-1), j'ai essayé d'écrire cela :
("Somme de " & Rep - 1) mais ça ne marche pas.

'Mettre à jour la semaine pour TCD à date des sites L
For Ind1 = 1 To 11
Sheets("Alertes").PivotTables("Tableau croisé dynamiques" & Ind1).PivotFields( _
"Somme de " & Rep - 1).Orientation = xlHidden
Sheets("Alertes").PivotTables("Tableau croisé dynamiques" & Ind1).AddDataField Sheets("Alertes"). _
PivotTables("Tableau croisé dynamiques" & Ind1).PivotFields(Rep), "Nombre de " & Rep, xlCount
With Sheets("Alertes").PivotTables("Tableau croisé dynamiques" & Ind1).PivotFields( _
"Nombre de " & Rep)
.Caption = Rep & " "
.Function = xlSum
End With
Next Ind1

 

[JCGL]

Re : VBA ajout élément dans plusieurs tableaux croisés dynamiques

Bonjour à tous,

Passe le numéro de semaine en numérique :

Sub Test_MAJ_SEMAINE()
    Dim Ind, Ind1, Inde As Integer
    Dim Rep As Byte

    Rep = InputBox("Pour quelle semaine ?", "Semaine au format xx", "00")

Et modifie le code en conséquence.
Sans fichier, je n'irais pas plus avant.

A+ à tous

 

[nico91410]

Re : VBA ajout élément dans plusieurs tableaux croisés dynamiques

tout simplement j'aimerais savoir comment supprimer tous les champs valeurs d'un TCD (pivotfield) afin d'éviter de faire la manip rep-1

 

[nico91410]

Re : VBA ajout élément dans plusieurs tableaux croisés dynamiques

Quelque chose comme cela :

Sub Macro4()
'
' Macro4 Macro


Dim pf As PivotField
ActiveSheet.PivotTables("Tableau croisé dynamiques5").PivotSelect "Site[All]", _
xlLabelOnly, True
For Each pf In ActiveSheet.PivotTables("Tableau croisé dynamiques5")
pf.Delete
Next

End Sub

Mais qui fonctionne.