Quantcast
Channel: blog.atwork.at
Viewing all articles
Browse latest Browse all 1118

Project: Zuordnungseinheiten neu berechnen / Recalculate Assignment Units

0
0
  1. Deutsch
  2. English
  3. Code

Deutsch

Im Artikel Zuordnungseinheiten in Project ab Version 2010 ist beschrieben, weshalb die Anzeige der Zuordnungseinheiten bei der Änderung von Dauer oder Arbeit ab Project 2010 nicht aktualisiert wird. Rod Gill aus Australien hat dazu ein Makro zur Verfügung gestellt, mit dem die Neuberechnung der Zuordnungseinheiten erfolgen kann: Reset Assignment Units. In Europa verwenden wir jedoch andere Regionaleinstellungen, daher finden Sie hier eine modifizierte Version.

In Makros implementieren / Implement Macros wird beschrieben, wie ein Makro in Project übernommen werden kann.Mehr Beispielmakros sind unter VBA zu finden.

English

The article Assignment Units in Project 2010 describes why the display of the assignment units is not updated when changing the duration or the work as of Project 2010. Rod Gill from Australia has provided a macro that can be used to recalculate the allocation units: Reset Assignment Units. In Europe, however, we use different regional settings, so you will find here a modified version.

Implementing Macros / Implement Macros describes how to apply a macro to Project. More sample code is available at VBA.

Code

Sub RefreshUnits()'***********************************************************************************'Code is provided “AS IS” without warranty of any kind, either expressed or implied,'including but not limited to the implied warranties of merchantability and/or'fitness for a particular purpose.'***********************************************************************************Dim Tsk As TaskDim Assgn As AssignmentDim v_Version AsIntegerDim v_StartDate AsDateDim v_TaskType AsLongDim v_Work AsLongDim v_v_MsgText AsString'Originally developed by Rod Gill - thanks for providing!!!'http://www.project-systems.co.nz/project-vba-macros/AssignmentUnitsReset.html'This macro runs on active Project 2010 and higher only.'Information for Assignmentunit Change at'http://blogs.msdn.com/b/project/archive/2010/04/29/assignment-units-in-project-2010.aspx'Modifications by Barbara Henhapl, http://www.henhapl.net' 1. Undo implemented' 2. Enable different regional settings'Please distribute with reference to'http://www.projectvbabook.com/VBA-Sample-Code/VBASampleResetAssignmentUnits.html only'Check version, with respect to regional settingsIfCInt(Replace(Application.Version, ".", Application.DecimalSeparator)) < 14 ThenSelectCase Application.LocaleIDCase 1031 'German
                        v_MsgText = "Dieses Makro ist nur für Project 2010 und höher sinnvoll, " _& "daher wird das Makro nun beendet."Case 1036  'French
                       v_MsgText = "Cette macro n'est utile que pour Project 2010 et les " _& "versions ultérieures. Elle sera donc terminée."Case 1043  'Dutch
                       v_MsgText = "Deze macro is alleen nuttig voor Project 2010 en later," _& " dus de macro wordt nu beëindigd."CaseElse' English and other
                        v_MsgText = "This macro is only useful for Project 2010 and later," _& " so macro is ended."EndSelect
                MsgBox v_MsgText, vbCritical + vbOKOnlyElse'Open a transaction to enable "Undo"
                Application.OpenUndoTransaction ("Refresh Units")ForEach Tsk In ActiveProject.TasksIfNot Tsk IsNothingThen'Only adjust Units for an Auto, incomplete, non-summary and active Task,'with AssignmentsIf Tsk.PercentComplete < 100 _AndNot Tsk.Summary _And Tsk.Active _And Tsk.Manual = False _And Tsk.Assignments.Count > 0 Then'no action required for tasks'without assignment'For recalculation of AssignmentUnits Task Type "Fixed Duration"'is required.'The original Task Type has to be set afterwards, keep the value
                            v_TaskType = Tsk.Type
                            Tsk.Type = pjFixedDurationForEach Assgn In Tsk.Assignments'Only adjust tasks not yet completedIf Assgn.PercentWorkComplete < 100 Then'Get the resume date for CompletedThroughIf Assgn.PercentWorkComplete > 0 Then
                                        v_StartDate = Tsk.Resume  'This is not necessarily'accurate but is close enoughElse
                                        v_StartDate = Assgn.StartEndIf'Keep work, since it will change during the following steps
                                    v_Work = Assgn.Work'IMPORTANT: For calculation of Remaining Duration, function'Application.DateDifference has to be used, since only this'function respects calendar exceptionsücksichtigt'If resource calendar are not set to "ignore", this calendar'has to be respected for calculation of Remaining Duration.'if there is no task calendar applied, Project calendar is'applied implicitely as task calendarIfNot Tsk.IgnoreResourceCalendar Then
                                        RemDur = Application.DateDifference _
                                        (v_StartDate, Assgn.Finish, Assgn.Resource.Calendar)Else
                                        RemDur = Application.DateDifference _
                                        (v_StartDate, _
                                         Assgn.Finish, _
                                         ActiveProject.BaseCalendars(Tsk.Calendar))EndIf'If there is RemainingDuration, AssignmentUnits are recalculated.'Afterwards, Assignment Work has to be set to the original valueIf RemDur > 0 Then
                                        Assgn.Units = Assgn.RemainingWork / RemDur
                                        Assgn.Work = v_WorkEndIfEndIfNext Assgn'Re-apply original Task Type
                            Tsk.Type = v_TaskTypeEndIfEndIfNext Tsk
                Application.CloseUndoTransactionEndIfEndSub

Viewing all articles
Browse latest Browse all 1118

Latest Images