probleme pour modifier tableau croisé dynamique automatiquement

Question

Bonjour,

je suis debutant et j'essaie de faire une macro pour me permettre  à partir d'un tableau croisé dynamique de modifier celui ci automatiquement et de faire un copievaleur à chaque fois pour l'integrer dans un onglet(ou feuille)

Dans un premier temps j'ai fait une fonction qui me repere les onglets sur mon fichier car ma selection sur mon TCD se fait en fonction de la liste de nom issue de cette fonction:
Public Function Nomfeuille(x As Integer) As String
Nomfeuille = Sheets(x).Name
End Function

J'ai donc une liste de nom d'onglets sur une colonne

voici le code:
Sub testTCD2()


Dim PT As PivotTable
Dim PI As PivotItem
Dim Fonds As String
Dim i, j As Integer


Set PT = ActiveSheet.PivotTables(1) 'on pourra eventuellement mettre le nom de la sheet souhaitée


j = Sheets("TCDpourReporting").Range("O4").Value ' nombre de feuille à faire


While i <= j


Fonds = Sheets("TCDpourReporting").Range("N22").Offset(i, 0).Value 'nom onglet et fonds à activer
'Fonds = Worksheets("gestion fichiers pour envoie").Range("R6").Offset(i, 0).Value


                
    For Each PI In PT.PivotFields("FundName").PivotItems
     
        If PI.Name <> Fonds Then
        PI.Visible = False
        Else: PI.Visible = True
        End If
        
    'ensuite il faut copier le tableau(en valeur seulement?) et l'inserer dans la worksheet ou workbook ad hoc
    'il faudra appeler les autres macro pour copie colle
   
   ActiveSheet.Activate
    Range("AZ9").Select
    
    Selection.Copy
    
    Sheets(Fonds).Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
    'Next PI


i = i + 1


Wend
End Sub

j'ai un message d'erreur qui me dit while sans wend mais avant j'avais un probleme il ne reconnait pas la boucle pour le pivotitem
car c'est ca le probleme principale que pivotItem soit egal à une valeur, qui est le nom de l'onglet inscrit dans une cellule

Merci bcp par avance dsl pour les explications confuses, je n'ai pas l'habitude

jmfmarques · Answer

Bonjour,
As-tu un moment à consacrer avec moi sur la différence existant entre ces 2 thèmes différents :

1)
 Thèmes / Visual Basic 6  (celui où nous nous trouvons)
et
2) : http://www.vbfrance.com/infomsgt_VBA_244.aspx

???

lillith212 · Answer

Bonjour, Fait attention tu as posté 2 fois le meme message. Un admin peut supprimer le post inutile merci... Je ne suis pas vbaiste mais... Sub testTCD2() Dim PT As PivotTable Dim PI As PivotItem Dim Fonds As String Dim i, j As Integer Set PT = ActiveSheet.PivotTables(1) 'on pourra eventuellement mettre le nom de la sheet souhaitée j = Sheets("TCDpourReporting").Range("O4").Value ' nombre de feuille à faire --> tu n'as pas initialisé ta valeur i While i <= j Fonds = Sheets("TCDpourReporting").Range("N22").Offset(i, 0).Value 'nom onglet et fonds à activer 'Fonds = Worksheets("gestion fichiers pour envoie").Range("R6").Offset(i, 0).Value For Each PI In PT.PivotFields("FundName").PivotItems If PI.Name <> Fonds Then PI.Visible = False Else PI.Visible = True End If 'ensuite il faut copier le tableau(en valeur seulement?) et l'inserer dans la worksheet ou workbook ad hoc 'il faudra appeler les autres macro pour copie colle ActiveSheet.Activate Range("AZ9").Select Selection.Copy Sheets(Fonds).Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False 'Next PI --> pourquoi ton next est en commantaire sachant que tu a mis un FOR... ?? c'est la raison de ton erreur sur le wend i = i + 1 Wend End Sub S.L.B.

-- Le règlement tu liras -- Des recherches tu feras -- Le style SMS tu banniras -- -- De la validation pertinente tu feras -- Du respect tu auras -- < S.L.B.

-- Le règlement tu liras -- Des recherches tu feras -- Le style SMS tu banniras -- -- De la validation pertinente tu feras -- Du respect tu auras -- <

matcaam · Answer

rebonjour, j'avais fait quelques erreurs de frappe avant de copier coller tout à) l'heure mais en fait je recois un message d'erreur qui me dit erreur d'execution '1004' impossible de définir la propriété Visible de la classe PivotItem
voici le code
Sub testTCD2()

Dim PT As PivotTable
Dim PI As PivotItem
Dim Fonds As String
Dim i, j As Integer



Set PT = Sheets("TCDpourReporting").PivotTables(1) 'on pourra eventuellement mettre le nom de la sheet souhaitée

j = Sheets("TCDpourReporting").Range("O4").Value ' nombre de feuille à faire
i = 1
While i <= j

Fonds = Sheets("TCDpourReporting").Range("N24").Offset(i, 0).Value 'nom onglet et fonds à activer
'Fonds = Worksheets("gestion fichiers pour envoie").Range("R6").Offset(i, 0).Value

        
        
    For Each PI In PT.PivotFields("FundName").PivotItems
     Debug.Print Fonds
        If PI.Name <> Fonds Then
        PI.Visible = False
        Else: PI.Visible = True
        End If
    Next PI
    'ensuite il faut copier le tableau(en valeur seulement?) et l'inserer dans la worksheet ou workbook ad hoc
    'il faudra appeler les autres macro pour copie colle
   
   ActiveSheet.Activate
    Range("AZ9").Select
    
    Selection.Copy
    
    Sheets(Fonds).Select
    Range("A3").Select
       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
    

i = i + 1

Wend


End Sub

merci par avance

Probleme pour modifier tableau croisé dynamique automatiquement

3 réponses

Votre réponse

Discussions similaires