Forum Discussion
Comment remplacer une ressource par une autre en VBA
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.
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.
John
- 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
jtsv.Delete
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- pascalito,
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.
JohnJohn-project Thanks, Let me know,