Comment remplacer une ressource par une autre en VBA

Copper Contributor



J'ai un problème fort simple, mais que je n'arrive pas à résoudre en VBA.


J'ai une ressource, on va dire Toto 

J'ai une autre ressource, on va dire Tutu


Je voudrais transférer les données Réels de Toto vers Tutu avec un script VBA.


Aujourd'hui, j'y parviens avec des boucles sur les affectations et les données réelles dans le temps (TimeScaleDate) de Toto, mais ça prend une éternité. 


Est-ce qu'il existe une façon simple d'y parvenir?


Merci par avance,



10 Replies

It depends. If for example Toto is no longer available (e.g. left the company), then it could be as simple as replacing Toto on the Resource Sheet with Tutu (i.e. change the resource name).

However, if Toto is still active elsewhere in your plan you will need to "capture" Toto's assignment information on each task and switch that over to Tutu.


If Toto is the only resource assigned to a task, then capturing his assignment units and actual work, if any should be all you need to make the transfer. Then delete Toto as the assigned resource, and add Tutu as the assigned resource using the captured assignment units and actual work.


If multiple resources are assigned to a task and Toto is one of them, you will need to capture Toto's assignment units, actual work, and assignment start and finish. Then delete Toto's assignment, add Tutu as a resource using the captured assignment data.


If Toto's assignment is non-linear (i.e. contoured) and you want to replicate that contour for Tutu, then you will have to make the transfer period by period using timescaled data. But if Toto's assignments are all linearly spread over the task duration, then the above simpler approaches should get you there.

Let me know.



Bonjour John,



C'est hélas bien ce que je craignais, dans le cas d'utilisation qui m'intéresse, je cherche à conserver les données de notre ami Toto parce que sa définition change, e.g. nouveau rôle, et donc pour préserver ces caractéristiques, je crée une copie de Toto dans une nouvelle fiche ressource, que j'appelle Tutu

Je transfère tous les réels de Toto sous Tutu. Pour les projets qui sont terminés, j'ai trouvé beaucoup plus rapide d'ouvrir les plans et de procéder à un remplacement de ressource Toto par Tutu. Ce qui se fait en un éclair.


Par contre, pour les projets en cours, j'utilise un script VBA, je balaye toutes les tâches de Toto, je crée  une nouvelle affectation pour Tutu, puis après je boucle dans le temps depuis le début de l'affectation jusqu'à la date effective, je mets les réels pour ce jour dans la nouvelle affectation et j'efface les réels de l'ancienne affectation.


Ça marche très bien, au détail près que ça prend une éternité, à chaque transfert le statut passe de Prêt à Occupé. Et j'aurais aimé accélérer le transfert.



For further posts please use English as this an an English based forum. I can translate using Google's language translator but that doesn't update the thread for the benefit of other users who may follow.

It sounds like you've figured out a process that works for the various scenarios (e.g. completed projects and on-going projects) but here's an idea you might want to consider. Save a copy of the plan with Toto as the resource, then save the plan under a new name and change the Resource Sheet such that Toto is now Tutu. True, the new plan will show Tutu as the original assignment but the difference in actual work (and any other resource attributes) is a "simple" subtraction of the plan saved with Toto and the new plan with Tutu. When I say "simple", this subtraction can be accomplished in various ways, a macro that uses extra fields in Project or better yet, a macro that exports data to Excel and customizes a report of the differences. I've done macros like that for years.

With regard to your macro taking a long time to run, it may be because the amount of data is very large or it could be the method(s) you are using in your VBA code. Some of my macros take a couple of minutes to fully execute when operating on large amounts of data but most run in a few seconds. Would you be willing to share your macro code with me and also your Project plan. Perhaps I can peruse your process and suggest ways to speed up processing. Keep in mind I do not speak French. If you're interested, let me know.
Bonjour John,

J'écris très mal en anglais et les outils de traduction font des merveilles.

Voici le code que j'exécute:

For Each gins In proj.Resources
If Not gins Is Nothing Then

For he = 1 To maxHE

AncienNom = heAncienNom(he)
NouveauNom = heNouveauNom(he)
NouveauEUID = heNouveauEUID(he)
Effectif = heEffectif(he)

If gins.Name = AncienNom Then

For Each affect In gins.Assignments

' he modification boucle et initialise les variables, vérifie besoin

If AncienNom <> "" And affect.ResourceName = AncienNom And affect.Start < Effectif And affect.Work > 0 Then

'Traite la tâche
Set tâche = affect.Task

'Détermine combien de valeurs doivent Être transférées
jusquo = Effectif - 1

'Converse le reste à faire pour le reprogrammer après le passage de la boucle
raf = affect.RemainingWork

'Conserve le retard
retard = affect.Delay

Set NouvAffect = Nothing

For j = 1 To tâche.Assignments.Count
If tâche.Assignments(j).ResourceName = NouveauNom Then Set NouvAffect = tâche.Assignments(j)
Next j

If NouvAffect Is Nothing Then
tâche.Assignments.Add ResourceID:=heRessourceId(he)
For j = 1 To tâche.Assignments.Count
If tâche.Assignments(j).ResourceID = heRessourceId(he) Then Set NouvAffect = tâche.Assignments(j)
Next j
NouvAffect.ResourceName = NouveauNom
End If

NouvAffect.Start = affect.Start
NouvAffect.ActualStart = affect.ActualStart
NouvAffect.Finish = jusquo

Set tsv = affect.TimeScaleData(affect.Start, jusquo, pjAssignmentTimescaledActualWork, pjTimescaleDays)

For Each jtsv In tsv
If Not jtsv Is Nothing Then
If jtsv.Value <> "" And jtsv.Value <> 0 Then
Set ntsv = NouvAffect.TimeScaleData(jtsv.StartDate, jtsv.EndDate, pjAssignmentTimescaledActualWork, pjTimescaleDays)
ntsv(1) = jtsv.Value
End If
End If
Next jtsv

Set tsv = affect.TimeScaleData(affect.Start, jusquo, pjAssignmentTimescaledActualWork, pjTimescaleYears)

For Each jtsv In tsv
If Not jtsv Is Nothing Then
End If
Next jtsv

If affect.Finish > jusquo Then affect.Start = Effectif
affect.RemainingWork = raf
NouvAffect.RemainingWork = 0

'Modification HE: fin de la boucle
Next affect

End If
Next he
End If
Next gins

Okay, thanks. I'll copy your code to my PC, perhaps do a little translating and then do some testing. It may be a day or two before I can get back to you.

@John-project Thanks, Let me know,


I took a quick look at your macro code but find there is too much missing (e.g. no variable declarations), too many French based variable names that don't translate to English and not enough comments. It would take too much effort on my part to figure it out such that I could make constructive comments. If you can translate your code to English, I'll have another look but otherwise I'm afraid your have to find a French based forum to get help.
best response confirmed by pascalito (Copper Contributor)



Thanks for your help, I've tight schedule to respect, and have no time for translating and editing code to make it smaller.

I guess, I'll have to take another approach that is less tedious, althought it might require much more manual editing.

You're welcome and thanks for the feedback. Sorry I couldn't have offered more help.



Ultimate update


1. There was an error in the code logarithm, the transfer was assumed to go from assignment start (affect.Start) date until the resource change takes effect (Effectif), regardless of the assignment finish date. Therefore, it took very long since we carry over 2018 assignments, which meant 1400 itérations where ca. 40 were required.


2. Optimizing the transfer using .Value, tsv.Value = oldTsv.Value instead of tsv = oldTsv.Value


3. The type of task also impacts the performance, effort driven fixed duration tasks. vs fixed units not effort driven

Althought it is not achieved in a flash, I managed to process 15 projects in an hour, which is acceptable.