Jaa

Moving Tasks With VBA

  • Artikkeli

So the problem was that a customer wanted to be able to move a task that was at ID 7 and move it so that it was at ID 2. Sadly, VBA for Project does not contain a Task.Move method. But with a little bit of code around them you can use a Cut and Paste methods for Rows.

The example below assumes that you know the name of the task you want to move and the name of the task that currently occupies the row where you want to move the first task.

Here is a sample task list. This sample is a good test because the tasks are out of ID order. The task I want to move (name = 7) is in ID position 3 and I want to move it to where Task 2 is now (currently in ID position 9.)

image

Sub TaskMover()
Dim t As Task
Dim NewID As Integer

For Each t In ActiveProject.Tasks
If Not (t Is Nothing) Then
If t.Name = 2 Then
NewID = t.ID
End If
If t.Name = 7 Then
SelectRow Row:=t.ID, Rowrelative:=False
EditCut
End If
End If
Next t

SelectRow Row:=NewID, Rowrelative:=False
EditPaste

End Sub

 

This code is not very elegant in that it requires us to select a row and then cut it and then select another row and then paste it. It also requires that the view in the activewindow is a Task view. There is some code we can use to test to make sure the view is the right type. “ActiveWindow.TopPane.View.Type” should be “0” or “pjTaskItem”. So it is not perfect but it gets the job done. You can use this as a starting point for your own needs.

So the new code with this view type test would look like this:

Sub TaskMover()
Dim t As Task
Dim NewID As Integer
If ActiveWindow.TopPane.View.Type = pjTaskItem Then
For Each t In ActiveProject.Tasks
If Not (t Is Nothing) Then
If t.Name = 2 Then
NewID = t.ID
End If
If t.Name = 7 Then
SelectRow Row:=t.ID, Rowrelative:=False
EditCut
End If
End If
Next t
SelectRow Row:=NewID, Rowrelative:=False
EditPaste
End If
End Sub

Comments

  • Anonymous
    October 14, 2008
    Hi Brian, Another way of doing this if you know the Task names is: Sub TaskMover2() Dim TskFrom As Task Dim TskTo As Task    If ActiveWindow.TopPane.View.Type = pjTaskItem Then        Set TskFrom = ActiveProject.Tasks("2")        Set TskTo = ActiveProject.Tasks("8")        If TskFrom Is Nothing Or TskTo Is Nothing Then            MsgBox "One of the task names does not exist, macro ended", vbCritical + vbOKOnly        Else            SelectRow Row:=TskFrom.ID, Rowrelative:=False            EditCut            SelectRow Row:=TskTo.ID, _                 Rowrelative:=False            EditPaste        End If    End If End Sub