Gestion d'erreur transfert TCD en VBA
Bonjour à Tous,
J'ai besoin de votre aide pour une partie de mon code..
Dans celui ci, je parcous deux TCD structurés de la meme façon, un TCD me donne les heures sur un projet donné et l'autre les Euros sur ce meme projet (les tableaux sont liés par un slicer):
En filtre : "Project_Name" : Les noms de projet
En colonne : "Source" : (EAC / EAC0 / Actual Last Closed Period)
En ligne : "Fiscal_Year_Period" : Les dates
Valeurs : "Hours" ou "Euros" selon le TCD
Ma macro permet de parcourir les différents projets de ces TCD, de copier les valeurs correspondant à une date choisie, sur un tableau qui me sert de dashboard.
voici mon code :
With Sh.PivotTables("Pivot_Euros")
.PivotCache.MissingItemsLimit = xlMissingItemsNone
.PivotCache.Refresh
With .PivotFields("Project_Name")
'---hide all items except item 1
.PivotItems(1).Visible = True
For i = 2 To .PivotItems.Count
.PivotItems(i).Visible = False
Next
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = True
If i <> 1 Then .PivotItems(i - 1).Visible = False
sItem = .PivotItems(i)
Cells(j, 2).Value = sItem
Cells(j, 3).Value = pT1.GetPivotData("Hours", "Source", "Actual Last Closed Period", "Fiscal_Year_Period", Cells(1, 1).Value).Value
Cells(j, 4).Value = pT1.GetPivotData("Hours", "Source", "EAC", "Fiscal_Year_Period", Cells(1, 1).Value).Value
Cells(j, 5).Value = pT1.GetPivotData("Hours", "Source", "EAC0", "Fiscal_Year_Period", Cells(1, 1).Value).Value
Cells(j, 6).Value = Cells(j, 3).Value / Cells(j, 4).Value - 1
Cells(j, 7).Value = Cells(j, 3).Value / Cells(j, 5).Value - 1
Cells(j, 8).Value = pT.GetPivotData("Euros", "Source", "Actual Last Closed Period", "Fiscal_Year_Period", Cells(1, 1).Value).Value
Cells(j, 9).Value = pT.GetPivotData("Euros", "Source", "EAC", "Fiscal_Year_Period", Cells(1, 1).Value).Value
Cells(j, 10).Value = pT.GetPivotData("Euros", "Source", "EAC0", "Fiscal_Year_Period", Cells(1, 1).Value).Value
Cells(j, 11).Value = Cells(j, 8).Value / Cells(j, 9).Value - 1
Cells(j, 12).Value = Cells(j, 9).Value / Cells(j, 10).Value - 1
j = j + 1
Next i
End With
Seulement je recontre des erreurs lorsqu'il manque des données dans ces tableaux..
Par consequent je souhaiterais mettre au point une gestion des erreurs m'indiquant lorsqu'il manque les données du genre :
"Project (i) : EAC0 non trouvé"
ou encore "Project (i) : Pas de données pour la date selectionnée" etc...
Voila j'éspère que vous saurez m'aider
Merci par avance,
Vincent
Bonjour,
Merci de joindre un fichier à ta demande.
Le forum pourra alors intervenir !...
Cdlt.
Et voici m'sieur
J'ai fais une version simplifiée dans laquelle j'ai volontairement mis des erreurs
- > Le Premier projet est bon
- > Le deuxième projet n'a pas d'actuals
- > Le troisième projet n'a pas de données pour la date saisie en A1 (03/01/2018)
Merci
PS : Mes données d'origine sont normalement sur access, un simple check de la table "Data" ne fonctionnerais pas
Re,
Ai je bien compris la chose ?
A te relire.
Cdlt.
Option Explicit
Sub Pivot_Check()
Dim wsData As Worksheet, wsPT As Worksheet
Dim pt As PivotTable
Dim rng As Range, rCell As Range
Dim dt As Date
Dim n As Double
Dim strDate As String, strFormat As String
Set wsData = Worksheets("Data")
Set wsPT = Worksheets("Pivot")
dt = wsPT.Cells(1).Value
Set rng = wsData.ListObjects(1).ListColumns(3).DataBodyRange
On Error Resume Next
n = Application.Match(CLng(dt), rng, 0)
If Err.Number <> 0 Then Err.Clear: Exit Sub
strFormat = "dd/mm/yyyy": strDate = Format(dt, strFormat)
For Each pt In wsPT.PivotTables
With pt.PivotFields("Fiscal_Year_Period")
.ClearAllFilters
.PivotFilters.Add2 Type:=xlSpecificDate, Value1:=strDate
End With
Next pt
With wsPT.ListObjects(1)
If .InsertRowRange Is Nothing Then
Set rCell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
Else
Set rCell = .InsertRowRange.Cells(1)
End If
End With
With wsPT
With rCell
.Value = .Cells(2, 18).Value
.Offset(, 1).Resize(, 3).Value = .Cells(6, 18).Resize(, 3).Value
.Offset(, 6).Resize(, 3).Value = .Cells(6, 24).Resize(, 3).Value
End With
End With
End Sub
Merci pour votre aide,
Cependant j'ai du manquer de clartée dans mon explication aha
Ce que je souhaite c'est vraiment une analyse des erreurs un truc du genre "On error go to" etc.. qui me renvoie l'erreur qui correspond..
Lorsque la macro vas boucler sur les ligne suivantes;
Cells(j, 2).Value = sItem
Cells(j, 3).Value = pT1.GetPivotData("Hours", "Source", "Actual Last Closed Period", "Fiscal_Year_Period", Cells(1, 1).Value).Value
Cells(j, 4).Value = pT1.GetPivotData("Hours", "Source", "EAC", "Fiscal_Year_Period", Cells(1, 1).Value).Value
Cells(j, 5).Value = pT1.GetPivotData("Hours", "Source", "EAC0", "Fiscal_Year_Period", Cells(1, 1).Value).Value
Cells(j, 6).Value = Cells(j, 3).Value / Cells(j, 4).Value - 1
Cells(j, 7).Value = Cells(j, 3).Value / Cells(j, 5).Value - 1
Cells(j, 8).Value = pT.GetPivotData("Euros", "Source", "Actual Last Closed Period", "Fiscal_Year_Period", Cells(1, 1).Value).Value
Cells(j, 9).Value = pT.GetPivotData("Euros", "Source", "EAC", "Fiscal_Year_Period", Cells(1, 1).Value).Value
Cells(j, 10).Value = pT.GetPivotData("Euros", "Source", "EAC0", "Fiscal_Year_Period", Cells(1, 1).Value).Value
Cells(j, 11).Value = Cells(j, 8).Value / Cells(j, 9).Value - 1
Cells(j, 12).Value = Cells(j, 9).Value / Cells(j, 10).Value - 1
Si il manque les données de type "actuals" ça me dirait lors de la copie depuis le TCD "Projet 2 : pas de valeurs actuals" par exemple
Compliqué a expliquer et donc a comprendre je l'admets aha
Re,
Il va falloir m'explique l'utilité de la chose, car une fois la procédure exécutée, il suffit de regarder les résultats dans le tableau pour analyse.
Cdlt.
Re,
Je te l'accorde, quand la base de données contiens que 3 projets de 3 lignes, "il suffit de regarder"..
Mais quand tu as plusieurs centaines de projets qui font plusieurs milliers de lignes, et que c'est refresh tout les mois.. Je serais content d'avoir un petit "rapport d'erreurs" plutôt que de me taper toute la table a lire a chaque fois que je rafraîchit les données
Voici mon explications de l'utilité de la chose, mais là n'est pas la question aha..
Cordialement