- Deutsch
- English
- Code
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.
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.
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 Task
Dim Assgn As Assignment
Dim v_Version As Integer
Dim v_StartDate As Date
Dim v_TaskType As Long
Dim v_Work As Long
Dim v_v_MsgText As String
'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 settings
If CInt(Replace(Application.Version, ".", Application.DecimalSeparator)) < 14 Then
Select Case Application.LocaleID
Case 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."
Case Else ' English and other
v_MsgText = "This macro is only useful for Project 2010 and later," _
& " so macro is ended."
End Select
MsgBox v_MsgText, vbCritical + vbOKOnly
Else
'Open a transaction to enable "Undo"
Application.OpenUndoTransaction ("Refresh Units")
For Each Tsk In ActiveProject.Tasks
If Not Tsk Is Nothing Then
'Only adjust Units for an Auto, incomplete, non-summary and active Task,
'with Assignments
If Tsk.PercentComplete < 100 _
And Not 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 = pjFixedDuration
For Each Assgn In Tsk.Assignments
'Only adjust tasks not yet completed
If Assgn.PercentWorkComplete < 100 Then
'Get the resume date for CompletedThrough
If Assgn.PercentWorkComplete > 0 Then
v_StartDate = Tsk.Resume 'This is not necessarily
'accurate but is close enough
Else
v_StartDate = Assgn.Start
End If
'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 calendar
If Not 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))
End If
'If there is RemainingDuration, AssignmentUnits are recalculated.
'Afterwards, Assignment Work has to be set to the original value
If RemDur > 0 Then
Assgn.Units = Assgn.RemainingWork / RemDur
Assgn.Work = v_Work
End If
End If
Next Assgn
'Re-apply original Task Type
Tsk.Type = v_TaskType
End If
End If
Next Tsk
Application.CloseUndoTransaction
End If
End Sub