Sub nouveau_TCD()
' ============================ '
' Code pour www.hastursoft.com '
' Zebra3 , le 16/03/2009 '
' ============================ '
Dim Idx_Ref As Variant
Dim NomMaj as String
'
' Suppression du contenu de l'onglet "TCD" qui contient le Tableau Croisé Dynamique
Sheets("TCD").Select
Cells.Select
Selection.Delete Shift:=xlUp
' Création d'un TCD tout neuf nommé "Mon_TCD" et adapté à la taille des données
' Le tableau des données est dans l'onglet "Données" et commencent en A4
' toutes les entêtes de colonnes sont sur la ligne 4)
' En A2 et A3 se trouvent le nombre de ligne et de colonnes du tableau des données
Range("A6").Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Données!R4C1:R" & 4 + Sheets("Données").Range("A2").Value & "C" & _
Sheets("Données").Range("A3").Value).CreatePivotTable _
TableDestination:=Range("A6"), _
TableName:="Mon_TCD"
ActiveSheet.PivotTables("Mon_TCD").SmallGrid = False
'
' Création des 3 Champs de Page (exemples: CPhase, CphZ et ZIP)
With ActiveSheet.PivotTables("Mon_TCD").PivotFields("CPhase")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("Mon_TCD").PivotFields("CPhZ")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("Mon_TCD").PivotFields("ZIP")
.Orientation = xlPageField
.Position = 1
End With
'
' Ajoute un Champ de colonne (exemple: AVI)
With ActiveSheet.PivotTables("Mon_TCD").PivotFields("AVI")
.Orientation = xlColumnField
.Position = 1
End With
'
' Ajoute 2 Champs de Ligne (exemple: Réf. et Client en première position)
With ActiveSheet.PivotTables("Mon_TCD").PivotFields("Réf.")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("Mon_TCD").PivotFields("Client")
.Orientation = xlRowField
.Position = 1
End With
'
' Ajoute les données (ex: QD à gauche et QT à droite, voir .Position)
With ActiveSheet.PivotTables("Mon_TCD").PivotFields("QD")
.Orientation = xlDataField
.Position = 1
End With
With ActiveSheet.PivotTables("Mon_TCD").PivotFields("QT")
.Orientation = xlDataField
.Position = 2
End With
'
' Organise les PivotFields (exemple: Données et AVI)
With ActiveSheet.PivotTables("Mon_TCD").PivotFields("Données")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("Mon_TCD").PivotFields("AVI")
.Orientation = xlColumnField
.Position = 1
End With
'
' Masque l'affichage des sous-Totaux. ajuster au besoin.
ActiveSheet.PivotTables("Mon_TCD").PivotFields("Client"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
'
' Masque la Table de Gestion du TCD
Application.CommandBars("PivotTable").Visible = False
'
' Ensuite peut masquer les Références non désirées
' Pour chaque "PivotItem" inclu dans "Réf." de "Mon_TCD"
For Each Idx_Ref In ActiveSheet.PivotTables("Mon_TCD").PivotFields("Réf.").PivotItems
' Récupère le Nom du "PivotItem" et le converti en Majuscule
NomMaj = StrConv(Idx_Ref.Name, xlUpper)
'Si le Nom du "PivotItem" contient les caractères de masquage (ex: SAV, REP, PREST)
If InStr(1, NomMaj, "SAV") > 0 Or _
InStr(1, NomMaj, "REP") > 0 Or _
InStr(1, NomMaj, "PREST") > 0 Then
' alors rend le pivotItem non Visible
ActiveSheet.PivotTables("Mon_TCD").PivotFields("Réf.").PivotItems(Idx_Ref.SourceName).Visible = False
End If
Next Idx_Ref
End Sub
Sub MasqueItems()
' ============================ '
' Code pour www.hastursoft.com '
' Zebra3 , le 16/03/2009 '
' ============================ '
Dim i As Integer
Dim Idx_Ref As Variant
Dim NomMaj as String
' Se positionne sur l'onglet nommé "TCD" qui contient le Tableau Croisé Dynamique
Sheets("TCD").Select
' Pour les Champs PivotFields nommés "Réf." contenu dans le TCD nommé "Mon_TCD"
With ActiveSheet.PivotTables("Mon_TCD").PivotFields("Réf.")
'Parcourre tous les Items
For i = 1 To .PivotItems.Count
' et les rend visible (même les fantômes)
.PivotItems(i).Visible = True
Next i
End With
' Ensuite peut masquer les Références non désirées
' avec un autre exemple pour parcourrir le TCD
' Pour chaque "PivotItem" inclu dans "Réf." de "Mon_TCD"
For Each Idx_Ref In ActiveSheet.PivotTables("Mon_TCD").PivotFields("Réf.").PivotItems
' Récupère le Nom du "PivotItem" et le converti en Majuscule
NomMaj = StrConv(Idx_Ref.Name, xlUpper)
'Si le Nom du "PivotItem" contient les caractères de masquage (ex: SAV, REP, PREST)
If InStr(1, NomMaj, "SAV") > 0 Or _
InStr(1, NomMaj, "REP") > 0 Or _
InStr(1, NomMaj, "PREST") > 0 Then
' alors rend le pivotItem non Visible
ActiveSheet.PivotTables("Mon_TCD").PivotFields("Réf.").PivotItems(Idx_Ref.SourceName).Visible = False
End If
Next Idx_Ref
End Sub
Retourner vers Propositions Acceptées
Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 1 invité