[vba] tableau croisé dynamique

Fermé
oln - 26 mars 2007 à 18:01
 vb - 24 juil. 2007 à 15:07
Bonjour,
Je suis débutant débutant sous VBA et j'essaye désespérément de programmer un programme qui dans un premier temps importerait des données, effacerait les doublons, garderait certaine données puis fasse un tableau croisée dynamique.
Mais la partie du programme censée faire le tableau croisé dynamique ne fonctionne lorsqu'il se situe dans le corps du programme. Le compilateur me dit que: "le nom du champ de tableau croisé dynamique n'est pas valide. Pour créer un rapport de tableau croisée dynamique, vous devez utiliser des données sous forme de liste avec des étiquettes de colonnes. si vous changez le nom d'un champ, vous devez taper un nouveau nom pour le champ

si quelqu'un pouvait m'aider ça serait vraiment sympa:

Voici le bout de programme qui ne fonctionne pas :

Sub TableauCroiséDynamique()

Dim CacheTCD As PivotCache
Dim TCD As PivotTable
Dim feuille As Worksheet
On Error Resume Next
Sheets("Mandats").DrawingObjects("TextBoxWait").Visible = True
On Error GoTo 0
Application.ScreenUpdating = False


'supprimer la feuille analyse si elle existe déjà
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Analyse").Delete
On Error GoTo 0

'Creer un tableau croisé dynamique
Set CacheTCD = ActiveWorkbook.PivotCaches.Add( _
SourceType:=xlDatabase, _
SourceData:=Sheets("Mandats").Range("A1").CurrentRegion.Address)


'ajout de la feuille Analyse
Worksheets.Add
ActiveSheet.Name = "Analyse"

'Creer un TCD à partir du cash
For Each feuille In Worksheets
If feuille.Name = "Analyse" Then
feuille.Activate

Set TCD = CacheTCD.CreatePivotTable( _
tabledestination:=Sheets("Analyse").Range("A1"), _
tablename:="TCDAnalyse")
End If
Next feuille



With TCD
'Ajout des champs
.PivotFields("MDT - Montant total du mandat").Orientation = xlRowField

.PivotFields("MDT - Budget (ligne)").Orientation = xlColumnField

.PivotFields("MDT - Section I/F").Orientation = xlColumnField

.PivotFields("MDT - N° BJ").Orientation = xlColumnField

.PivotFields("MDT - N° de mandat émis").Orientation = xlColumnField

.PivotFields("Tiers").Orientation = xlColumnField

.PivotFields("MDT - Compte").Orientation = xlColumnField

.PivotFields("FCT - Niv. réglementaire").Orientation = xlColumnField

.PivotFields("MDT - UAG").Orientation = xlColumnField

End With

Application.ScreenUpdating = True


End Sub

2 réponses

Voici une sub que j'utilise pour créer des TCD. Peut-être pourrez-vous vous en inspirer.

J'en ai fait une version un peu améliorée mais je ne la trouve pas en ce moment.



Sub TCD()

Application.ScreenUpdating = False
    
'la feuille contenant le bouton doit être celle contenant la base de données que l'on veut utiliser
Dim Feuille As String
Feuille = ActiveSheet.Name

Sheets(Feuille).Activate

'dimension de la plage contenant les données
Dim DataR As Long
Dim DataC As Integer
Dim Source As String

Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
    
DataR = Selection.CurrentRegion.Rows.Count
DataC = Selection.CurrentRegion.Columns.Count
Source = "bd!R1C1:R" & CStr(DataR) & "C" & CStr(DataC)

Dim Champs As Variant
Dim Nom As String

Dim Col As Integer
Dim Ran As Integer

Dim Dispo As Long
Dim c As Integer

Dim FWS As Worksheet

'MÉNAGE: crée ou réinitialise les feuilles nécessaires
Add = 1

For i = 1 To Sheets.Count

    If Sheets(i).Name = "TCD" Then Add = 0
    
Next i

If Add = 0 Then
    Sheets("TCD").Activate
    Range("A1").Select
    Cells.Select
    Selection.Delete shift:=xlUp
Else
    Set FWS = Sheets.Add
    With FWS
        .Move after:=Sheets(Sheets.Count)
        .Name = "TCD"
    End With
End If

  
''''''''''''''''''''''''''''''''''''''

'routine qui crée les TCD
Champs = Array("*", "TYPE_SERVI", "LIGNE", _
                "**", "DIRECTION", "TRACE", "PERIODE", "POSITION", "LIEU", _
                "***", "CLA_PONC", _
                "****", "OCC_PONC", _
                "*****")
                
'destination
Sheets("TCD").Activate
Range("A3").Select

Nom = "TCD: Ponctualité par position"

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    Source).CreatePivotTable TableDestination:=Selection, TableName:=Nom

ActiveSheet.PivotTables(Nom).SmallGrid = False

c = 0

Do While Champs(c) <> "*****"

    'DEBUG
    'MsgBox (Champs(c) & " - " & Dispo)
    
    'les champs sont disposés selon le symboles qui les précède
    
    Select Case Champs(c)
    
        Case "*"
            Dispo = xlPageField
        Case "**"
            Dispo = xlRowField
        Case "***"
            Dispo = xlColumnField
        Case "****"
            Dispo = xlDataField
        Case Else
            ActiveSheet.PivotTables(Nom).PivotFields(Champs(c)).Orientation = Dispo
            
    End Select
    
    c = c + 1
    
Loop

ActiveSheet.PivotTables(Nom).PivotFields("TYPE_SERVI"). _
    CurrentPage = "SE"
    
ActiveSheet.PivotTables(Nom).PivotFields("PERIODE").PivotItems("MA"). _
    Position = 1

'masque les sommes non désirées
Dim Colonne As String
Colonne = "A"
For i = 1 To 4

    j = 6
    
    Do While Left(CStr(Range(Colonne & CStr(j)).Value), 5) <> "Somme"
    
        j = j + 1
        
    Loop
    
    Range(Colonne & CStr(j)).Delete
    
    Colonne = IncrementC(Colonne, 1)

Next i

'mise en page
Sheets("TCD").Activate
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select

End Sub

15
j'ai exactement le même problème ...... mais je remarque que quand je fais "du pas à pas" pas de pb, ça passe tres bien ... étrange, mais ça m'ennuie fortement .. si qq 1 a une idée!!!
0