Bug Macro VBA Excel sur Tableaux Croisés Dynamiques

Ici se trouvent les Propositions Acceptées en attente de Mise en Forme

Bug Macro VBA Excel sur Tableaux Croisés Dynamiques

Message non lupar Zebra3 » Dim 15 Mar 2009 12:45

J'ai trouvé une solution concernant le bug des Macros VBA Excel (reconnu par Microsoft) et concernant le décochage des objets dans la table. C'est radical mais cela marche. Est-ce que cela peut être un sujet ?
Zebra3
Avatar de l’utilisateur
Zebra3
Contributeur
Contributeur
 
Messages: 18
Inscription: Dim 15 Mar 2009 12:05

Si Vous avez Trouvé votre Bonheur,
ou si vous voulez aider ce site à progresser...
Merci de penser à
donate
ou bien encore, Inscrivez-Vous ! (c'est gratuit et sans publicité bloquante)
Vous pourrez suivre les évolutions, les mises à jour, et participer... MERCI.

Re: Bug Macro VBA Excel sur Tableaux Croisés Dynamiques

Message non lupar hastursoft » Dim 15 Mar 2009 18:38

C'est tout à fait le genre de solutions qui concerne ce site.
Si dans ton cas, c'est un bug officiel reconnu par le concepteur et qu'il ne propose pas de solution, ou que la tienne semble plus efficace, alors c'est encore mieux !
Tu peux poster des éléments dans les "Propositions de Solutions" ou à la suite de ce message en y répondant. Je m'occuperai de la mise en forme pour, après évaluation la poster dans le Forum des Solutions.
Merci de ta collaboration à ce Site. :D
hastursoft
Administrateur
Administrateur
 
Messages: 273
Inscription: Sam 14 Juin 2008 21:02

Re: Bug Macro VBA Excel sur Tableaux Croisés Dynamiques

Message non lupar Zebra3 » Lun 16 Mar 2009 23:19

Le Problème:
Erreur d'exécution de la macro excel dans un tableau croisé dynamique lors de la manipulation des "pivotitems". Principalement lorsqu'ils ne peuvent être préalablement triés et qu'il existe des "pivotitems" hérités de traitements précédents et déjà masqués. De plus le masquage de références commençant par la même racine , ou possédant la même chaine de masquage, ou bien même la consultation d'un élément non visible arrivent au même résultat : le plantage de la macro.

La solution 1 (il y en a une deuxième que je viens de trouver):
Radicale il est vrai, consiste à supprimer le TCD et de le recréer. Cela a l'avantage de supprimer les "pivotsitems" fantômes, et que ceux qui sont présents soient bien visibles. Permettant sans plantage de masquer à loisir ceux que l'on désire.
Code: Tout sélectionner
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


La solution 2:
En partant du constat de ce que j'ai écrit en solution 1, il m'est venue l'idée de parcourir tous les éléments pour les rendre tous visible avant de réaliser les masquages. Et a priori, cela fonctionne. C'est moins radical, un peu plus long en traitement sur les gros fichiers et cela ne tue pas les "pivotitems" fantômes.
Code: Tout sélectionner
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


A+
Zebra3
Avatar de l’utilisateur
Zebra3
Contributeur
Contributeur
 
Messages: 18
Inscription: Dim 15 Mar 2009 12:05

Re: Bug Macro VBA Excel sur Tableaux Croisés Dynamiques

Message non lupar hastursoft » Mar 17 Mar 2009 02:38

Superbe travail :D
Et cela fonctionne !
Je déplace le sujet dans les Propositions Acceptées, pour mise en forme (ce qui sera assez rapide sachant qu'il n'y aura pas grand chose à retoucher).
Je ne clos pas le sujet pour l'instant afin que des commentaires puissent être ajoutés éventuellement par la suite.
hastursoft
Administrateur
Administrateur
 
Messages: 273
Inscription: Sam 14 Juin 2008 21:02

Re: Bug Macro VBA Excel sur Tableaux Croisés Dynamiques

Message non lupar hastursoft » Sam 17 Avr 2010 01:53

Image
Ce Sujet a donc été décomposé en 2 Solutions Retenues:
Très bonne contribution Zebra3, merci.
=> Cloture du Sujet


Sujet remonté par hastursoft le Sam 17 Avr 2010 01:53.
hastursoft
Administrateur
Administrateur
 
Messages: 273
Inscription: Sam 14 Juin 2008 21:02


Retourner vers Propositions Acceptées

 


  • Articles en relation
    Réponses
    Vus
    Dernier message

Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 1 invité

Si Vous avez Trouvé votre Bonheur,
ou si vous voulez aider ce site à progresser...
Merci de penser à
donate
ou bien encore, Inscrivez-Vous ! (c'est gratuit et sans publicité bloquante)
Vous pourrez suivre les évolutions, les mises à jour, et participer... MERCI.