[MACRO-TCD] Avec une Base dynamique
Bonjour tout le monde,
Cela fait 2 jours que je suis sur ce soucis, j'ai trouver pas mal de morceau sur internet mais en vein... J'ai tester par enregistrement mais quand je lance la macro il ne m'affiche pas mon resultat comme convenue
Donc,
Est-il possible de crée via VBA ( sans enregistrement ) un Tableau croisée dynamique.
J'ai une base sur la Feuille BDD j'aimerais en faire un croisée dynamique et le mettre sur la feuille GRAPHIQUE, une foit le TCD pondue, si c'est possible qu'il me génère un graphique
Attention : la BDD est pas fixe, parfois elle aurais des 100ene de ligne en plus et parfois en moin... donc je peu pas trop definir de plage pour le TCD et en vba c'est déliquat
Résumé :
- Prendre la BDD en faire un TCD
- Les libéllé dans Colonne / Ligne / Valeurs c'est à votre guise, j'adapterais en fonction de ce que vous aurez pu trouver
- pondre un graphique....
J'ai un support de travail si vous pouvez me donner un coup de main ce serait génial
Merci d'avance en tout cas
Lien :
Bonjour,
met ta base de données sous forme de tableau et les données qui s'y ajoutent seront prises en compte par le TCD.
Avec une macro évènementielle à l'activation de l'onglet "Graphique" le TCD s'actualise.
@ + +
Arf je crois pas que cela va etre possible j'explique les étape :
- J'ai ma trame
- j'ai un bouton qui me permet d'importer les donner dans une feuille
- j'aimerais un Macro qui me permet de crée un TCD de cette base de donnée sans le faire en mode enregistrement ( car il enregistre les position et pas les données... )
une fois terminer la trame n'est pas enregistrer, elle se réinitialise, donc sur l'utilisation suivante on ré-importe une base de donnée mais le nombre de ligne est supérieur/inférieur
- en gros c'est crée via un macro un TCD de la Base située en feuille sachant que sa plage sera de : A1 ==> Derniere ligne/colonne non vide
Bonjour,
Et si tu donnais un exemple de résultat escompté ?
Cdlt.
Donc après importation de ma base j'obtient "Source 1" :
https://www.cjoint.com/c/FHyqApiuHTP
après macro j'obtient result 1 :
https://www.cjoint.com/c/FHyqAzkMQWP
Mais parfois ma base est plus grande/petite : Source 2
https://www.cjoint.com/c/FHyqAKRfP1P
Mais le resultat est similaire au N°1 : Result 2
https://www.cjoint.com/c/FHyqATxHkRP
J'avais penser pour la création du TCD une formule qui comptait le nombre de ligne non vide et cette valeur determinera la longueur de la BDD du TCD...
Le point bloquant est de d'utiliser une macro qui saura sélectionner toutes les données de la Base de donnée quelque soit son nombre de ligne
Re,
Une proposition à tester.
Cdlt.
Option Explicit
Public Sub DEMO()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim ACell As Range
Dim lo As ListObject
Dim PTCache As PivotCache
Dim pt As PivotTable
Dim objChart As ChartObject
Dim rngChart As Range
Dim lRow As Long
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
'-------------------------------------------------------------------
Set wb = ActiveWorkbook
Set wsData = wb.Worksheets("BDD")
If wsData.Cells(1).ListObject Is Nothing Then
Set lo = wsData.ListObjects.Add _
(xlSrcRange, _
wsData.Cells(1).CurrentRegion, , xlYes)
Else
Set lo = wsData.Cells(1).ListObject
End If
'-------------------------------------------------------------------
On Error Resume Next
wb.Worksheets("Graphique").Delete
On Error GoTo 0
'-------------------------------------------------------------------
Application.DisplayAlerts = True
'-------------------------------------------------------------------
Set PTCache = wb.PivotCaches.Create(xlDatabase, lo.Range)
'-------------------------------------------------------------------
Set wsPT = wb.Worksheets.Add(After:=Worksheets(Worksheets.Count))
wsPT.Name = "Graphique"
'-------------------------------------------------------------------
Set pt = PTCache.CreatePivotTable(wsPT.Cells(2, 2), "PT_1")
With pt
.ManualUpdate = True
.AddFields RowFields:="secteur", ColumnFields:="sexe"
With .PivotFields("sexe")
.Orientation = xlDataField
.Position = 1
.Function = xlCount
.NumberFormat = "#,##0;[Red]-#,##0;"
.Caption = "NB"
End With
.RowAxisLayout xlTabularRow
.TableStyle2 = "PivotStyleMedium2"
.ManualUpdate = False
End With
'-------------------------------------------------------------------
With wsPT
lRow = .Cells(Rows.Count, 2).End(xlUp).Row + 3
Set objChart = .ChartObjects.Add _
(Left:=.Cells(lRow, 2).Left, _
Top:=.Cells(lRow, 2).Top, _
Width:=400, _
Height:=250)
Set rngChart = pt.TableRange2
End With
'-------------------------------------------------------------------
With objChart.Chart
.SetSourceData rngChart
.ShowAllFieldButtons = False
End With
'-------------------------------------------------------------------
Set objChart = Nothing
Set rngChart = Nothing
Set pt = Nothing
Set PTCache = Nothing
Set lo = Nothing
Set wsPT = Nothing: Set wsData = Nothing
Set wb = Nothing
End Subil me met ce message et surligne la ligne juste au dessus par la suite :
Par contre il determine bien le nombre de ligne
Bonjour,
Vérifie les chaînes de caractères, en supprimant les espaces inutiles.
Cdlt.
Problème toujours présent...
J'ai supprimer ce bloque ducoup
il me crée bien un TCD et un Graphique qui fait reference à ce TCD
Le souci c'est qu'il les remplis pas automatiquement...
je n'arrive pas à placer la commande permettant de mettre une en-tête dans "Ligne" "Colonne" "Valeur" et quand je prend les fonction sur internet toujours un souvis au niveaux du débogage
Option Explicit
Public Sub DEMO()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim ACell As Range
Dim lo As ListObject
Dim PTCache As PivotCache
Dim pt As PivotTable
Dim objChart As ChartObject
Dim rngChart As Range
Dim lRow As Long
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
'-------------------------------------------------------------------
Set wb = ActiveWorkbook
Set wsData = wb.Worksheets("BDD")
If wsData.Cells(1).ListObject Is Nothing Then
Set lo = wsData.ListObjects.Add _
(xlSrcRange, _
wsData.Cells(1).CurrentRegion, , xlYes)
Else
Set lo = wsData.Cells(1).ListObject
End If
'-------------------------------------------------------------------
On Error Resume Next
wb.Worksheets("Graphique").Delete
On Error GoTo 0
'-------------------------------------------------------------------
Application.DisplayAlerts = True
'-------------------------------------------------------------------
Set PTCache = wb.PivotCaches.Create(xlDatabase, lo.Range)
'-------------------------------------------------------------------
Set wsPT = wb.Worksheets.Add(After:=Worksheets(Worksheets.Count))
wsPT.Name = "Graphique"
'-------------------------------------------------------------------
Set pt = PTCache.CreatePivotTable(wsPT.Cells(2, 2), "PT_1")
'-------------------------------------------------------------------
With wsPT
lRow = .Cells(Rows.Count, 2).End(xlUp).Row + 3
Set objChart = .ChartObjects.Add _
(Left:=.Cells(lRow, 2).Left, _
Top:=.Cells(lRow, 2).Top, _
Width:=400, _
Height:=250)
Set rngChart = pt.TableRange2
End With
'-------------------------------------------------------------------
With objChart.Chart
.SetSourceData rngChart
.ShowAllFieldButtons = False
End With
'-------------------------------------------------------------------
Set objChart = Nothing
Set rngChart = Nothing
Set pt = Nothing
Set PTCache = Nothing
Set lo = Nothing
Set wsPT = Nothing: Set wsData = Nothing
Set wb = Nothing
End SubRESOLU
Re,
Si tu n'arrives pas à créer tes champs lignes, colonnes ou valeurs, c'est que tes libellés ne correspondent pas aux libellés des données sources !
Cdlt.
Avec des enregistrer quelque bidouillage j'obtiens :
- une reconnaissance de la de la base et de sa taille
- création d'un TCD + Graphique
- Par contre je voudrais qu'il me place par default certain libellés dans : Colonne / Valeur / Ligne
j'ai essayer quelque truc avec les formules predefinie au placement mais je plante la dessus :
ActiveSheet.PivotTables("PT_1").AddDataField ActiveSheet.PivotTables("PT_1"). _
PivotFields("Libelle valeur"), "Nombre de Libelle valeur", xlCountc'est vers la fin
Option Explicit
Public Sub DEMO()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim ACell As Range
Dim lo As ListObject
Dim PTCache As PivotCache
Dim pt As PivotTable
Dim objChart As ChartObject
Dim rngChart As Range
Dim lRow As Long
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
'-------------------------------------------------------------------
Set wb = ActiveWorkbook
Set wsData = wb.Worksheets("BDD")
If wsData.Cells(1).ListObject Is Nothing Then
Set lo = wsData.ListObjects.Add _
(xlSrcRange, _
wsData.Cells(1).CurrentRegion, , xlYes)
Else
Set lo = wsData.Cells(1).ListObject
End If
'-------------------------------------------------------------------
On Error Resume Next
wb.Worksheets("Graphique").Delete
On Error GoTo 0
'-------------------------------------------------------------------
Application.DisplayAlerts = True
'-------------------------------------------------------------------
Set PTCache = wb.PivotCaches.Create(xlDatabase, lo.Range)
'-------------------------------------------------------------------
Set wsPT = wb.Worksheets.Add(After:=Worksheets(Worksheets.Count))
wsPT.Name = "Graphique"
'-------------------------------------------------------------------
Set pt = PTCache.CreatePivotTable(wsPT.Cells(2, 2), "PT_1")
'-------------------------------------------------------------------
With wsPT
lRow = .Cells(Rows.Count, 2).End(xlUp).Row + 3
Set objChart = .ChartObjects.Add _
(Left:=.Cells(lRow, 2).Left, _
Top:=.Cells(lRow, 2).Top, _
Width:=400, _
Height:=250)
Set rngChart = pt.TableRange2
End With
'-------------------------------------------------------------------
With objChart.Chart
.SetSourceData rngChart
.ShowAllFieldButtons = False
End With
'-------------------------------------------------------------------
Set objChart = Nothing
Set rngChart = Nothing
Set pt = Nothing
Set PTCache = Nothing
Set lo = Nothing
Set wsPT = Nothing: Set wsData = Nothing
Set wb = Nothing
ActiveSheet.PivotTables("PT_1").AddDataField ActiveSheet.PivotTables("PT_1"). _
PivotFields("Libelle valeur"), "Nombre de Libelle valeur", xlCount
With ActiveSheet.PivotTables("PT_1").PivotFields("Libelle valeur")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("PT_1").PivotFields("RessourceID")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.ChartType = xlColumnStacked
ActiveChart.ApplyLayout (10)
End SubBonjour,
Bon, je crois que l'on a un gros souci !
Envoie un classeur avec des données représentatives avec un TCD et un GCD crées manuellement.
Nous verrons ensuite pour automatiser leurs créations.
Je commenterai la procédure pour une meilleure compréhension.
Cdlt.
Nota : Et inutile de passer par cjoint.com pour des classeurs de petites tailles. Et ne modifie pas l'extension des fichiers !