- Deutsch
- English
- Code
Deutsch
Alle Jahre wieder ... Gegen Jahresende gibt es immer wieder die Anforderung, die Kostensätze für Ressourcen für das Folgejahr einzutragen. Hier stelle ich ein Makro bereit, der das Ganze mit VBA vereinfacht. Mit dem Code können Sie Kostensätze für jeweils eine Kostensatztabelle ändern. Für Änderungen
- in einem einfachen Projekt mit lokalen Ressourcen öffen Sie dieses Projekt
- für Enterprise Ressourcen aus Project Online oder Project Server öffnen Sie die Unternehmensressourcen im Client zur Bearbeitung
- von Ressourcen in einem gemeinsamen Ressourcenpool öffnen Sie den gemeinsamen Ressourcenpool
Wenden Sie eine Ressourcenansicht, z.B. Ressource:Tabelle. Blenden Sie Kostenspalten ein, die noch nicht in Verwendung sind (Kosten1 - Kosten 10, ....). Ich verwende in diesem Code vorhandene Kostenfelder, um Probleme mit Einheitsbezeichnungen und Währungskennzeichen beim Import zu vermeiden. Wenn Sie nur den Standardsatz ergänzen möchten, ist ein Kostenfeld ausreichend. Für Überstundensatz oder Kosten pro Einsatz benötigen Sie bei Bedarf ebenfalls je ein Kostenfeld. Tragen Sie in diese Felder die neuen Kostensätze ein.
Passen Sie im Code die verwendeten Felder an (Kosten1 -> Cost1, ...).
Ändern Sie bei Bedarf den Text für Benachrichtigungen. Die Konstanten "c_" werden in der Folge ein Eingabeaufforderungen oder Benachrichtigungen verwendet.
Wenn Sie das Makro starten, werden Sie zur Datumseingabe aufgefordert. Als Standardwert wird der 1. Januar des Folgejahres angezeigt.
Wenn es bereits Kostensätze gibt, deren Effektives Datum nach Ihrem Eingabewert liegt, werden dies Einträge gelöscht. Die eingetragenen Werte werden durch das Makro für jede Ressource ergänzt.
Wenn Sie die Kostensätze für Unternehmensressourcen von Project Online oder Project Server vor dem Stichtag eintragen, öffnen Sie die Ressourcen nach dem Stichtag erneut und speichern Sie sie, um die neuen Kostensätze auch im Browser angezeigt zu bekommen.
Ich hoffe, dass ich damit Projektmanagern und Administratoren das Leben etwas erleichtere.
Ein wichtiger Hinweis zum Testen (ich übernehme keine Garantie bei Fehlfunktion, beantworte aber gerne Fragen dazu): Wenn das Ergebnis nicht überzeugt, schließen Sie das Projekt ohne Speichern.
In Makros implementieren / Implement Macros wird beschrieben, wie ein Makro in Project übernommen werden kann. Mehr Beispielmakros sind unter VBA zu finden.
English
Every year again ... Towards the end of the year there is always the requirement to enter the cost rates for resources for the following year. Here I provide a macro that simplifies the whole thing with VBA. You can use the code to change cost rates for one cost rate table at a time. For changes
-
in a simple project with local resources open this project
- for enterprise resources from Project Online or Project Server, open the Enterprise resources in the client for editing
- from resources in a Shared Resource Pool, open the Shared Resource Pool
Apply a resource view, e.g. Resource Sheet. Show cost columns that are not yet in use (cost1 - cost 10, ...). In this code, I am using existing cost fields to avoid problems with unit names and currency symbols with an import. If you only want to add to the standard rate, one cost field is sufficient. If necessary, you also need a cost field for overtime rates or costs per assignment. Enter the new cost rates in these fields.
Adjust the fields used in the code (Cost1 -> Cost1, ...).
Change the text for notifications if necessary. The constants "c_" are used in the sequence of prompts or notifications.
When you start the macro, you will be prompted for the date. The default value is January 1st of the following year.
If there are already cost rates whose effective date is after your input value, these entries will be deleted. The values entered are supplemented by the macro for each resource.
If you enter the cost rates for company resources from Project Online or Project Server before the deadline, open the resources again after the deadline and save them so that the new cost rates are also displayed in the browser.
I hope that this will make life a little easier for project managers and administrators.
An important note for testing (I do not guarantee malfunction, but will be happy to answer questions): If the result is not as expected, close the project without saving.
Implementing Macros / Implement Macros describes how to apply a macro to Project. More sample code is available at VBA.
Code
Sub UpdateStandardRates()
'***********************************************************************************
'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.
'***********************************************************************************
'Adjust input text for start date of new standard rate
Const c_InputDate = "Enter start date for new rate"
'Adjust information text for invalid start date of new standard rate
Const c_InvalidDate = "Invalid date"
'Adjust reminder text when changing standard rates of Enterprise resources (using Project Online or Project Server
Const c_EnterpriseResourcesCheckedOutreminder1 = "Remember to delete all values from"
Const c_EnterpriseResourcesCheckedOutreminder2 = "before saving"
'Adjust field names used for new standard rates
Const c_StdRate = "Cost1"
Const c_OvtRate = "Baseline2Cost" '"Cost2"
Const c_CostPerUse = "" '"Cost3"
Dim P As Project
Dim R As Resource
Dim CR As CostRateTable
Dim PR As PayRate
Dim v_Date As Date
Dim v_StdRate
Dim v_OvtRate
Dim v_CostPerUse
Dim v_MsgText As String
Set P = ActiveProject
On Error Resume Next
v_Date = InputBox(Prompt:=c_InputDate, Default:=DateSerial(Year(Date) + 1, 1, 1))
On Error GoTo 0
'catch Cancel
If v_Date = "00:00:00" Then
Exit Sub
End If
If Not IsDate(v_Date) Then
MsgBox (c_InvalidDate)
Exit Sub
End If
For Each R In P.Resources
'With Project Online or Project Server, standard rates for Enterprise resources can only be adjusted in Checked-Out Enterprise Resources:
'"P.Type = pjProjectTypeEnterpriseResourcesCheckedOut And R.Enterprise = True"
'other resources can be adjusted in any project
'"R.Enterprise = False"
If (P.Type = pjProjectTypeEnterpriseResourcesCheckedOut And R.Enterprise = True) Or R.Enterprise = False Then
'only dealing with rate table "A" in this sample
'for B: Set CR = R.CostRateTables(2), ....
Set CR = R.CostRateTables(1)
'get last payrate
Set PR = CR.PayRates(CR.PayRates.Count)
If PR.EffectiveDate >= v_Date Then
PR.Delete
End If
v_StdRate = R.GetField(FieldNameToFieldConstant(c_StdRate, pjResource))
If c_OvtRate <> "" Then
v_OvtRate = R.GetField(FieldNameToFieldConstant(c_OvtRate, pjResource))
Else
v_OvtRate = "0,00 " & Split(v_StdRate, " ")(1)
End If
If c_CostPerUse <> "" Then
v_CostPerUse = R.GetField(FieldNameToFieldConstant(c_CostPerUse, pjResource))
Else
v_CostPerUse = "0,00 " & Split(v_StdRate, " ")(1)
End If
Set PR = CR.PayRates.Add(v_Date & " 00:00:00", v_StdRate, v_OvtRate, v_CostPerUse)
End If
Next R
If P.Type = pjProjectTypeEnterpriseResourcesCheckedOut Then
v_MsgText = c_EnterpriseResourcesCheckedOutreminder1
v_MsgText = v_MsgText + vbCrLf + vbTab + c_StdRate
If c_OvtRate <> "" Then
v_MsgText = v_MsgText + vbCrLf + vbTab + c_OvtRate
End If
If c_CostPerUse <> "" Then
v_MsgText = v_MsgText + vbCrLf + vbTab + c_CostPerUse
End If
v_MsgText = v_MsgText + vbCrLf + c_EnterpriseResourcesCheckedOutreminder2
MsgBox Prompt:=v_MsgText, Buttons:=vbCritical
End If
End Sub