Hi !
I'm working on some macros, in order to automatize a long and boring process, of analyzing data.
The first one is working perfectly, no errors, nothing. (I'm just posting it if it can in some ways interfere with the following macros)
Just after this one, I execute the second Macro :
And I get the error
Run-time Error -2147417848 (80010108)
Automation Error
The Object invoked has disconnected from its clients.
I've already looked throught this forum and stackoverflow for an answer, and I found nothing concluding.
From what I'm understanding, it's coming from the pivot tables, but all the changes I tried to make didn't change anything...
Do any of you have an idea of what can be the problem ?
Thanks a lot, and sorry for my poor english.
I'm working on some macros, in order to automatize a long and boring process, of analyzing data.
The first one is working perfectly, no errors, nothing. (I'm just posting it if it can in some ways interfere with the following macros)
Code:
Attribute VB_Name = "Module1"
Sub traitement()
Attribute traitement.VB_ProcData.VB_Invoke_Func = "a\n14"
Dim varConnected As String, varCompleted As String, varNoAction As String, varUnsub As String, varValidated As String, varJoined As String, varEntered As String, varStarted As String, varSupported As String, varFinished As String, varInvited As String, varNotInterested As String
Dim i As Long, maxEvaluator As Long
Dim dt As Date
Dim liveExists As Boolean, speakerExists As Boolean
' TRADUCTIONS ICI
Dim varNameCampaigns As String, varNameRecruiters As String, varNameConnections As String, varNameCandidates As String, varNameLive As String, varNameSpeaker As String, finalMessage As String, varYes As String, varNo As String, varContinue As String, varPublicLink As String, varEvaluation As String, varNbrTimeEvaluated As String, varDelay As String, varRateInPercent As String, varJobType As String, varContractType As String
varNameCampaigns = "Campaigns"
varNameRecruiters = "Recruiters"
varNameConnections = "Connections"
varNameCandidates = "Candidates"
varNameLive = "Live"
varNameSpeaker = "Speaker"
varPublicLink = "Public Link"
varYes = "YES"
varNo = "NO"
varEvaluation = "Evaluation"
varNbrTimeEvaluated = "Number of time evaluated"
varDelay = "Delay"
varRateInPercent = "Rate Recalculated in %"
varJobType = "Job Type"
varContractType = "Contract Type"
varContinue = "Continue"
finalMessage = "The execution of the first part of the macro is now over. Please fill all the missing columns, as Job Type in the Campaigns sheet. Then, please click on the button in the Connections sheet in order to continue."
' Here I detect if the sheets Live & Speaker exist
liveExists = False
speakerExists = False
For Each Sheet In Worksheets
If varNameLive = Sheet.Name Then
liveExists = True
ElseIf varNameSpeaker = Sheet.Name Then speakerExists = True
End If
Next Sheet
'''''''''''''''''''''''''''''''''''''''''''''''''
' PARTIE 1 : SÉLECTIONNER LES PLAGES DE DONNÉES '
'''''''''''''''''''''''''''''''''''''''''''''''''
'Permet d'enregistrer les sélections déjà faites
Worksheets(varNameCampaigns).Activate
Selection.Name = "selectionCampaigns"
Worksheets(varNameRecruiters).Activate
Selection.Name = "selectionRecruiters"
Worksheets(varNameConnections).Activate
Selection.Name = "selectionConnections"
Worksheets(varNameCandidates).Activate
Selection.Name = "selectionCandidates"
If liveExists Then
Worksheets(varNameLive).Activate
Selection.Name = "selectionLive"
End If
If speakerExists Then
Worksheets(varNameSpeaker).Activate
Selection.Name = "selectionSpeaker"
End If
''''''''''''''''''''''
' FEUILLE CANDIDATES '
''''''''''''''''''''''
' On accède à la feuille Candidates, et on la sélectionne
Worksheets(varNameCandidates).Activate
' Attribution des valeurs des variables String
varConnected = "Candidate connected"
varCompleted = "Interview completed"
varNoAction = "Candidate with no action"
varUnsub = "Candidate unsubscribed"
varValidated = "validated"
varJoined = "joined"
varEntered = "entered"
varStarted = "started"
varSupported = "supported"
varFinished = "finished"
varInvited = "invited"
varNotInterested = "notinterested"
' On remplace dans la sélection selectionCandidates les anciens noms par les nouveaux (par exemple validated=>Interview Completed)
With Range("selectionCandidates")
.Replace what:=varValidated, replacement:=varCompleted, lookat:=xlPart, MatchCase:=False
.Replace what:=varJoined, replacement:=varConnected, lookat:=xlPart, MatchCase:=False
.Replace what:=varEntered, replacement:=varConnected, lookat:=xlPart, MatchCase:=False
.Replace what:=varStarted, replacement:=varConnected, lookat:=xlPart, MatchCase:=False
.Replace what:=varSupported, replacement:=varConnected, lookat:=xlPart, MatchCase:=False
.Replace what:=varFinished, replacement:=varConnected, lookat:=xlPart, MatchCase:=False
.Replace what:=varInvited, replacement:=varNoAction, lookat:=xlPart, MatchCase:=False
.Replace what:=varNotInterested, replacement:=varUnsub, lookat:=xlPart, MatchCase:=False
End With
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Cells(1, 29).Value = varPublicLink
For i = LastRow To 2 Step -1
If IsEmpty(Cells(i, 17).Value) Then
Cells(i, 29).Value = varYes
Else
Cells(i, 29).Value = varNo
End If
Next i
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = LastRow To 2 Step -1
If (LCase(Cells(i, 29).Value) Like "yes") And ((LCase(Cells(i, 2).Value) Like "interview completed") Or (LCase(Cells(i, 2).Value) Like "candidate unsubscribed")) Then
Cells(i, 17).Value = Cells(i, 16).Value
End If
Next i
Cells(1, 27).Value = varEvaluation
Cells(1, 28).Value = varNbrTimeEvaluated
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Cells(i, 20) = Cells(i, 20).Value
If Cells(i, 20).Value = 0 And Cells(i, 21).Value = 0 And Cells(i, 22).Value = 0 Then
Cells(i, 27).Value = varNo
Else
Cells(i, 27).Value = varYes
If Cells(i, 20).Value > Cells(i, 21).Value Then
maxEvaluator = Cells(i, 20).Value
Else
maxEvaluator = Cells(i, 21).Value
End If
Cells(i, 28).Value = maxEvaluator
End If
Next i
' Calc avg delay
Cells(1, 26).Value = varDelay
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
' NOTE DE DEV: Possible de l'optimiser, en n'enregistrant pas la différence de dates, si la valeur est > à 7J, rajouter une condition au if : And (Cells(i, 16).Value - Cells(i, 17).Value)<8
If (LCase(Cells(i, 2).Value) Like "interview completed") And Not IsEmpty(Cells(i, 17).Value) Then Cells(i, 26).Value = (Cells(i, 16).Value - Cells(i, 17).Value)
Next i
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FEUILLE CAMPAIGNS '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' On accède à la feuille Campaigns, et on la sélectionne
Worksheets(varNameCampaigns).Activate
' On définit la variable lastrow comme étant la dernière ligne
LastRow = Range("A" & Rows.Count).End(xlUp).Row
' Boucle permettant de passer à travers chaque ligne, si aucun ajout de candidat ET aucune complétion ET aucun candidat, alors suppression de la ligne
'For i = lastrow To 2 Step -1
' If (Cells(i, 11).Value = 0) And (Cells(i, 12).Value = 0) And (Cells(i, 13).Value = 0) And (Cells(i, 14).Value = 0) Then Cells(i, 11).EntireRow.Delete
'Next i
' On re-définit la variable lastrow comme étant la dernière ligne
'lastrow = Range("A" & Rows.Count).End(xlUp).Row
' Boucle permettant de passer à travers chaque ligne, si le nom de la campagne début par test OU demo OU generic_campaign OU generic_name, alors suppression de la ligne
For i = LastRow To 2 Step -1
If (LCase(Cells(i, 2).Value) Like "test*") Or (LCase(Cells(i, 2).Value) Like "*campagne de démonstration") Or (LCase(Cells(i, 2).Value) Like "*campagne sans titre*") Or (LCase(Cells(i, 2).Value) Like "*campagna di dimostrazione*") Or (LCase(Cells(i, 2).Value) Like "*campagna sanza titolo*") Or (LCase(Cells(i, 2).Value) Like "*campanã sin titulo*") Or (LCase(Cells(i, 2).Value) Like "*campanã de demostración*") Or (LCase(Cells(i, 2).Value) Like "demo*") Then Cells(i, 2).EntireRow.Delete
Next i
' On nomme la celle V1 en tant que "Rate Recalculated"
Cells(1, 20).Value = varRateInPercent
' Boucle permettant de remplir cette nouvelle colonne, en recalculant le Taux, et en arrondissant au deuxième chiffre après la virgule
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Not ((Cells(i, 12).Value = 0) And (Cells(i, 14).Value = 0)) Then Cells(i, 20).Value = ((Cells(i, 14).Value) * 1000) / (Cells(i, 12).Value)
Next i
' On formatte la colonne en %
Range("V:V").NumberFormat = "00, %"
Range("C:D").EntireColumn.Insert
Range("C1").Value = varJobType
Range("D1").Value = varContractType
Dim pos1 As Integer, pos2 As Integer, pos3 As Integer, pos4 As Integer, pos5 As Integer, pos6 As Integer, pos7 As Integer
Dim contractString As String
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
contractString = LCase(Cells(i, 2).Value)
pos1 = InStr(contractString, "stage")
pos2 = InStr(contractString, "stagiaire")
pos3 = InStr(contractString, "alternance")
pos4 = InStr(contractString, "alternant")
pos5 = InStr(contractString, "apprentissage")
pos6 = InStr(contractString, "cdd")
pos7 = InStr(contractString, "cdi")
If pos1 > 0 Or pos2 > 0 Then
Cells(i, 4).Value = "Stage"
ElseIf pos3 > 0 Or pos4 > 0 Or pos5 > 0 Then Cells(i, 4).Value = "Alternance/Apprentissage"
ElseIf pos6 > 0 Then Cells(i, 4).Value = "CDD"
ElseIf pos7 > 0 Then Cells(i, 4).Value = "CDI"
Else
Cells(i, 4).Value = "Autre"
End If
Next i
'''''''''''''''''''''''
' FEUILLE CONNECTIONS '
'''''''''''''''''''''''
Worksheets(varNameConnections).Activate
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Cells(i, 1).Value = Left(Cells(i, 1).Value, 10)
Cells(i, 1) = Format(Cells(i, 1), "dd/mm/yyyy")
If Application.IsText(Cells(i, 1)) Then
dt = CDate(Cells(i, 1).Value)
Cells(i, 1).Value = dt
End If
Next i
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = LastRow To 2 Step -1
If (Cells(i, 5).Value = "Back Office authentication") Then Cells(i, 5).EntireRow.Delete
Next i
' FEUILLE LIVE
If liveExists Then
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Cells(i, 1).Value = Left(Cells(i, 1).Value, 10)
Cells(i, 1) = Format(Cells(i, 1), "dd/mm/yyyy")
If Application.IsText(Cells(i, 1)) Then
dt = CDate(Cells(i, 1).Value)
Cells(i, 1).Value = dt
End If
Next i
End If
' FEUILLE SPEAKER
Worksheets(varNameConnections).Activate
ActiveSheet.Buttons.Add(478.5, 29.25, 122.25, 47.25).Select
Selection.OnAction = "PERSONAL.XLSB!analyseCampagne"
Selection.Name = "ContinueRefreshButton"
Selection.Characters.Text = varContinue
With Selection.Characters(Start:=1, Length:=8).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 20
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = True
.Underline = xlUnderlineStyleNone
.ColorIndex = 5
End With
Worksheets(varNameCampaigns).Activate
MsgBox finalMessage
End SubJust after this one, I execute the second Macro :
Code:
Attribute VB_Name = "Module2"
Sub analyseCampagne()
' On déclare les variables
Dim PSheet As Worksheet, DSheet As Worksheet, sht As Worksheet
Dim PCache As PivotCache, pc As PivotCache
Dim PTable As PivotTable, pt As PivotTable
Dim PRange As Range
Dim LastRow As Long, LastCol As Long, LastRowTraitement As Long, LastColTraitement As Long
Dim pf As PivotField
Dim i, X As Integer
Dim sizePivotTable As Long, oldValue As Long
oldValue = 0
Dim varNameCampaigns As String, varNameRecruiters As String, varNameConnections As String, varNameCandidates As String, varNameLive As String, varNameSpeaker As String, varContinue As String
varNameCampaigns = "Campaigns"
varNameRecruiters = "Recruiters"
varNameConnections = "Connections"
varNameCandidates = "Candidates"
varNameLive = "Live"
varNameSpeaker = "Speaker"
varContinue = "Refresh"
' On insère une nouvelle feuille Analyse-Campagne
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Analyse-Campagne").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Analyse-Campagne"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Analyse-Campagne")
Set DSheet = Worksheets("Campaigns")
' On défini la sélection des données à ajouter au tableau croisé dynamique (TCD)
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
' On défini le cache du TCD
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange).CreatePivotTable(TableDestination:=PSheet.Cells(2, 1), TableName:="CampaignsActivation")
' On insère un TCD vide
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="CampaignsActivation")
' On ajoute un ligne
With ActiveSheet.PivotTables("CampaignsActivation").PivotFields("Launch date")
.Orientation = xlRowField
.Position = 1
.AutoGroup
End With
' On insère les données
With ActiveSheet.PivotTables("CampaignsActivation").PivotFields("Campaign")
.Orientation = xlDataField
.Position = 1
.Function = xlCount
.NumberFormat = "#,##0"
.Name = "Nombre de Campagnes"
End With
ActiveSheet.PivotTables("CampaignsActivation").PivotFields("Trimestres").Orientation = xlHidden
With ActiveSheet.PivotTables("CampaignsActivation").PivotFields("Candidates")
.Orientation = xlPageField
.Position = 1
.CurrentPage = "(All)"
.PivotItems("0").Visible = False
.EnableMultiplePageItems = True
End With
' On déplie toutes les sous catégories (Années -> Mois), afin de ne pas avoir de TCD qui se chevauchent
On Error Resume Next
i = 1
For Each sht In Worksheets
For Each pt In sht.PivotTables
For Each pf In pt.RowFields
pf.ShowDetail = True
Next pf
i = i + 1
Next pt
Next sht
On Error GoTo 0
' On défini les deux variables LastColTraitement et LastRowTraitement, qui permettent de rendre le placement des TCD dynamique
LastColTraitement = PSheet.Cells(4, Columns.Count).End(xlToLeft).Column + 2
LastRowTraitement = PSheet.Cells(Rows.Count, 1).End(xlUp).Row + 5
sizePivotTable = PSheet.Cells(Rows.Count, 1).End(xlUp).Row - oldValue
oldValue = PSheet.Cells(Rows.Count, 1).End(xlUp).Row
If sizePivotTable < 15 Then
resizeSpace = 15 - sizePivotTable
LastRowTraitement = LastRowTraitement + resizeSpace
oldValue = LastRowTraitement
End If
' On rajoute un titre au TCD, avec une couleur en arrière plan, et le texte en blanc et en gras
With Range("A2")
.Interior.Color = RGB(255, 0, 0)
.Value = "Activations Campagnes"
.Activate
End With
ActiveCell.Font.Bold = True
ActiveCell.Font.Color = vbWhite
' On rajoute un lien vers l'emplacement du graphique, et un de retour vers le TCD
With ActiveSheet.Hyperlinks
.Add Anchor:=ActiveSheet.Cells(3, LastColTraitement), Address:="", SubAddress:=Cells(3, 98).Address, TextToDisplay:="Graphique Activation Campagnes"
.Add Anchor:=ActiveSheet.Cells(3, 98), Address:="", SubAddress:=Cells(1, 1).Address, TextToDisplay:="Retour au TCD"
End With
' On rajoute le graphique, et on le déplace vers les cases 90
ActiveSheet.Shapes.AddChart2(297, xlColumnStacked).Select
With ActiveChart
.SetSourceData Source:=Sheets("Analyse-Campagne").Cells(((LastRowTraitement) - 8), 2)
.Parent.Name = "Activation Campagnes"
.HasTitle = True
.ChartTitle.Text = "Activation Campagnes"
End With
With ActiveSheet.Shapes("Activation Campagnes")
.Left = Cells(3, 90).Left
.Top = Cells(3, 90).Top
End With
' On rajoute le deuxième TCD
ActiveWorkbook.Worksheets("Analyse-Campagne").PivotTables("CampaignsActivation").PivotCache.CreatePivotTable TableDestination:=PSheet.Cells(LastRowTraitement, 1), TableName:="DraftCampaigns"
Cells(LastRowTraitement, 2).Select
With ActiveSheet.PivotTables("DraftCampaigns")
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = True
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
.PivotCache.RefreshOnFileOpen = False
.PivotCache.MissingItemsLimit = xlMissingItemsDefault
.RepeatAllLabels xlRepeatLabels
End With
With ActiveSheet.PivotTables("DraftCampaigns").PivotFields("Candidates")
.Orientation = xlPageField
.Position = 1
.CurrentPage = "(All)"
.PivotItems("0").Visible = False
.EnableMultiplePageItems = True
End With
With ActiveSheet.PivotTables("DraftCampaigns").PivotFields("Campaign")
.Orientation = xlRowField
.Position = 1
.Caption = "Campagne"
End With
ActiveSheet.PivotTables("DraftCampaigns").AddDataField ActiveSheet.PivotTables("DraftCampaigns").PivotFields("Candidates"), "Somme de Candidates", xlSum
ActiveSheet.PivotTables("DraftCampaigns").AddDataField ActiveSheet.PivotTables("DraftCampaigns").PivotFields("Completed interviews"), "Somme de Completed interviews", xlSum
ActiveSheet.PivotTables("DraftCampaigns").AddDataField ActiveSheet.PivotTables("DraftCampaigns").PivotFields("Rate"), "Somme de Rate", xlSum
With ActiveSheet.PivotTables("DraftCampaigns").PivotFields("Somme de Rate")
.Function = xlAverage
.Caption = "Moyenne du Taux"
End With
With ActiveSheet.PivotTables("DraftCampaigns").PivotFields("Candidates")
.Orientation = xlPageField
.Position = 1
.CurrentPage = "(All)"
.PivotItems("0").Visible = False
.EnableMultiplePageItems = True
.Caption = "Candidats"
End With
On Error Resume Next
i = 1
For Each sht In Worksheets
For Each pt In sht.PivotTables
For Each pf In pt.RowFields
pf.ShowDetail = True
Next pf
i = i + 1
Next pt
Next sht
On Error GoTo 0
With Cells(LastRowTraitement - 1, 1)
.Interior.Color = RGB(255, 0, 0)
.Value = "Campagnes Test"
.Activate
End With
ActiveCell.Font.Bold = True
ActiveCell.Font.Color = vbWhite
LastColTraitement = PSheet.Cells(LastRowTraitement + 1, Columns.Count).End(xlToLeft).Column + 2
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
With ActiveChart
.SetSourceData Source:=Sheets("Analyse-Campagne").Cells((LastRowTraitement), 2)
.Parent.Name = "Campagnes Tests"
.HasTitle = True
.ChartTitle.Text = "Campagnes Tests"
.FullSeriesCollection(1).ChartType = xlColumnClustered
.FullSeriesCollection(1).AxisGroup = 1
.FullSeriesCollection(2).ChartType = xlColumnClustered
.FullSeriesCollection(2).AxisGroup = 1
.FullSeriesCollection(3).ChartType = xlLine
.FullSeriesCollection(3).AxisGroup = 2
End With
With ActiveSheet
.Shapes("Campagnes Tests").Left = Cells(LastRowTraitement, 90).Left
.Shapes("Campagnes Tests").Top = Cells(LastRowTraitement, 90).Top
.Hyperlinks.Add Anchor:=ActiveSheet.Cells(LastRowTraitement, LastColTraitement), Address:="", SubAddress:=Cells(LastRowTraitement, 98).Address, TextToDisplay:="Graphique Campagnes Test"
.Hyperlinks.Add Anchor:=ActiveSheet.Cells(LastRowTraitement, 98), Address:="", SubAddress:=Cells(LastRowTraitement, 1).Address, TextToDisplay:="Retour au TCD"
End With
' TROISIEME TCD
LastRowTraitement = PSheet.Cells(Rows.Count, 1).End(xlUp).Row + 5
sizePivotTable = PSheet.Cells(Rows.Count, 1).End(xlUp).Row - oldValue
oldValue = PSheet.Cells(Rows.Count, 1).End(xlUp).Row
If sizePivotTable < 15 Then
resizeSpace = 15 - sizePivotTable
LastRowTraitement = LastRowTraitement + resizeSpace
oldValue = LastRowTraitement
End If
ActiveWorkbook.Worksheets("Analyse-Campagne").PivotTables("CampaignsActivation").PivotCache.CreatePivotTable TableDestination:=PSheet.Cells(LastRowTraitement, 1), TableName:="CandidatesProfiles"
Cells(LastRowTraitement, 2).Select
With ActiveSheet.PivotTables("CandidatesProfiles")
.PivotCache.RefreshOnFileOpen = False
.PivotCache.MissingItemsLimit = xlMissingItemsDefault
.RepeatAllLabels xlRepeatLabels
End With
With ActiveSheet.PivotTables("CandidatesProfiles").PivotFields("Job Type")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("CandidatesProfiles").AddDataField ActiveSheet.PivotTables("CandidatesProfiles").PivotFields("Candidates"), "Somme de Candidates", xlSum
With ActiveSheet.PivotTables("CandidatesProfiles").PivotFields("Candidates")
.Orientation = xlPageField
.Position = 1
.PivotItems("0").Visible = False
End With
On Error Resume Next
i = 1
For Each sht In Worksheets
For Each pt In sht.PivotTables
For Each pf In pt.RowFields
pf.ShowDetail = True
Next pf
i = i + 1
Next pt
Next sht
On Error GoTo 0
With Cells(LastRowTraitement - 1, 1)
.Interior.Color = RGB(255, 0, 0)
.Value = "Profils Candidats"
.Activate
End With
ActiveCell.Font.Bold = True
ActiveCell.Font.Color = vbWhite
LastColTraitement = PSheet.Cells(LastRowTraitement + 1, Columns.Count).End(xlToLeft).Column + 2
ActiveSheet.Shapes.AddChart2(251, xlPie).Select
With ActiveChart
.SetSourceData Source:=Sheets("Analyse-Campagne").Cells((LastRowTraitement), 2)
.ChartArea.Select
.FullSeriesCollection(1).Select
.Parent.Name = "Profils Candidats"
.HasTitle = True
.ChartTitle.Text = "Profils Candidats"
End With
With ActiveSheet
.Shapes("Profils Candidats").Left = Cells(LastRowTraitement, 90).Left
.Shapes("Profils Candidats").Top = Cells(LastRowTraitement, 90).Top
.ChartObjects("Profils Candidats").Activate
.Hyperlinks.Add Anchor:=ActiveSheet.Cells(LastRowTraitement, LastColTraitement), Address:="", SubAddress:=Cells(LastRowTraitement, 98).Address, TextToDisplay:="Graphique Profils Candidats"
.Hyperlinks.Add Anchor:=ActiveSheet.Cells(LastRowTraitement, 98), Address:="", SubAddress:=Cells(LastRowTraitement, 1).Address, TextToDisplay:="Retour au TCD"
End With
With ActiveChart
.SetElement (msoElementDataLabelOutSideEnd)
.ApplyDataLabels
.FullSeriesCollection(1).DataLabels.Select
End With
With Selection
.ShowPercentage = True
.ShowValue = False
End With
' QUATRIEME TCD
LastRowTraitement = PSheet.Cells(Rows.Count, 1).End(xlUp).Row + 5
sizePivotTable = PSheet.Cells(Rows.Count, 1).End(xlUp).Row - oldValue
oldValue = PSheet.Cells(Rows.Count, 1).End(xlUp).Row
If sizePivotTable < 15 Then
resizeSpace = 15 - sizePivotTable
LastRowTraitement = LastRowTraitement + resizeSpace
oldValue = LastRowTraitement
End If
ActiveWorkbook.Worksheets("Analyse-Campagne").PivotTables("CampaignsActivation").PivotCache.CreatePivotTable TableDestination:=PSheet.Cells(LastRowTraitement, 1), TableName:="ReturnRate"
Cells(LastRowTraitement, 2).Select
With ActiveSheet.PivotTables("ReturnRate")
.PivotCache.RefreshOnFileOpen = False
.PivotCache.MissingItemsLimit = xlMissingItemsDefault
.RepeatAllLabels xlRepeatLabels
End With
ActiveSheet.PivotTables("ReturnRate").AddDataField ActiveSheet.PivotTables("ReturnRate").PivotFields("Rate"), "Somme de Rate", xlSum
With ActiveSheet.PivotTables("ReturnRate").PivotFields("Somme de Rate")
.Caption = "Moyenne de Rate"
.Function = xlAverage
End With
With ActiveSheet.PivotTables("ReturnRate").PivotFields("Moyenne de Rate")
.NumberFormat = "0"
End With
With ActiveSheet.PivotTables("ReturnRate").PivotFields("Job Type")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("ReturnRate").PivotFields("Candidates")
.Orientation = xlPageField
.Position = 1
.CurrentPage = "(All)"
.PivotItems("0").Visible = False
.EnableMultiplePageItems = True
End With
On Error Resume Next
i = 1
For Each sht In Worksheets
For Each pt In sht.PivotTables
For Each pf In pt.RowFields
pf.ShowDetail = True
Next pf
i = i + 1
Next pt
Next sht
On Error GoTo 0
With Cells(LastRowTraitement - 1, 1)
.Interior.Color = RGB(255, 0, 0)
.Value = "Taux de retour par candidat"
.Activate
End With
ActiveCell.Font.Bold = True
ActiveCell.Font.Color = vbWhite
LastColTraitement = PSheet.Cells(LastRowTraitement + 1, Columns.Count).End(xlToLeft).Column + 2
ActiveSheet.Shapes.AddChart2(297, xlColumnStacked).Select
With ActiveChart
.SetSourceData Source:=Sheets("Analyse-Campagne").Cells((LastRowTraitement), 2)
.FullSeriesCollection(1).Select
.ChartArea.Select
.Parent.Name = "Taux de retour par candidat"
.HasTitle = True
.ChartTitle.Text = "Taux de retour par candidat"
.SetElement (msoElementDataLabelInsideEnd)
.ApplyDataLabels
.FullSeriesCollection(1).DataLabels.Select
End With
With ActiveSheet
.Shapes("Taux de retour par candidat").Left = Cells(LastRowTraitement, 90).Left
.Shapes("Taux de retour par candidat").Top = Cells(LastRowTraitement, 90).Top
.Hyperlinks.Add Anchor:=ActiveSheet.Cells(LastRowTraitement, LastColTraitement), Address:="", SubAddress:=Cells(LastRowTraitement, 98).Address, TextToDisplay:="Graphique Taux de retour par candidat"
.Hyperlinks.Add Anchor:=ActiveSheet.Cells(LastRowTraitement, 98), Address:="", SubAddress:=Cells(LastRowTraitement, 1).Address, TextToDisplay:="Retour au TCD"
End With
' CINQUIEME TCD
LastRowTraitement = PSheet.Cells(Rows.Count, 1).End(xlUp).Row + 5
sizePivotTable = PSheet.Cells(Rows.Count, 1).End(xlUp).Row - oldValue
oldValue = PSheet.Cells(Rows.Count, 1).End(xlUp).Row
If sizePivotTable < 15 Then
resizeSpace = 15 - sizePivotTable
LastRowTraitement = LastRowTraitement + resizeSpace
oldValue = LastRowTraitement
End If
ActiveWorkbook.Worksheets("Analyse-Campagne").PivotTables("CampaignsActivation").PivotCache.CreatePivotTable TableDestination:=PSheet.Cells(LastRowTraitement, 1), TableName:="TypeContracts"
Cells(LastRowTraitement, 2).Select
With ActiveSheet.PivotTables("TypeContracts")
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = True
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
.PivotCache.RefreshOnFileOpen = False
.PivotCache.MissingItemsLimit = xlMissingItemsDefault
.RepeatAllLabels xlRepeatLabels
End With
With ActiveSheet.PivotTables("TypeContracts").PivotFields("Candidates")
.Orientation = xlPageField
.Position = 1
.CurrentPage = "(All)"
.PivotItems("0").Visible = False
.EnableMultiplePageItems = True
End With
With ActiveSheet.PivotTables("TypeContracts").PivotFields("Contract Type")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("TypeContracts").AddDataField ActiveSheet.PivotTables("TypeContracts").PivotFields("Candidates"), "Somme de Candidates", xlSum
On Error Resume Next
i = 1
For Each sht In Worksheets
For Each pt In sht.PivotTables
For Each pf In pt.RowFields
pf.ShowDetail = True
Next pf
i = i + 1
Next pt
Next sht
On Error GoTo 0
With Cells(LastRowTraitement - 1, 1)
.Interior.Color = RGB(255, 0, 0)
.Value = "Type de contrat"
.Activate
End With
ActiveCell.Font.Bold = True
ActiveCell.Font.Color = vbWhite
LastColTraitement = PSheet.Cells(LastRowTraitement + 1, Columns.Count).End(xlToLeft).Column + 2
With ActiveSheet
.Hyperlinks.Add Anchor:=ActiveSheet.Cells(LastRowTraitement, LastColTraitement), Address:="", SubAddress:=Cells(LastRowTraitement, 98).Address, TextToDisplay:="Graphique Type de contrat"
.Hyperlinks.Add Anchor:=ActiveSheet.Cells(LastRowTraitement, 98), Address:="", SubAddress:=Cells(LastRowTraitement, 1).Address, TextToDisplay:="Retour au TCD"
.Shapes.AddChart2(251, xlDoughnut).Select
End With
With ActiveChart
.SetSourceData Source:=Sheets("Analyse-Campagne").Cells((LastRowTraitement), 2)
.SetElement (msoElementDataLabelShow)
.ChartArea.Select
.Parent.Name = "Type de contrat"
.HasTitle = True
.ChartTitle.Text = "Type de contrat"
.ApplyDataLabels
.FullSeriesCollection(1).DataLabels.Select
End With
Selection.ShowPercentage = True
Selection.ShowValue = False
With ActiveSheet
.Shapes("Type de contrat").Left = Cells(LastRowTraitement, 90).Left
.Shapes("Type de contrat").Top = Cells(LastRowTraitement, 90).Top
End With
Application.CommandBars("Format Object").Visible = False
ActiveWorkbook.ShowPivotTableFieldList = False
Cells(1, 1).Activate
Worksheets(varNameConnections).Activate
ActiveSheet.Shapes("ContinueRefreshButton").Select
Selection.Characters.Text = varContinue
End SubAnd I get the error
Run-time Error -2147417848 (80010108)
Automation Error
The Object invoked has disconnected from its clients.
I've already looked throught this forum and stackoverflow for an answer, and I found nothing concluding.
From what I'm understanding, it's coming from the pivot tables, but all the changes I tried to make didn't change anything...
Do any of you have an idea of what can be the problem ?
Thanks a lot, and sorry for my poor english.
