Search code examples
vbams-project

How to "Undo" after macro run?


I am running a code, that changes the format of the task's row, based on a value in Text1 field.

If I change the Duration, or Finish or some other values when I update the schedule, the value of Text1 (customized field) is modified as well. As a result of that value, I am formatting the background color and the font color.

Once I run this code, I can't use the regular "Undo" so I can't get the values to return to their previous state.

How do I create the "Custom Undo"?

ThisProject Code

Private Sub Project_Change(ByVal pj As Project)
    ' enable class to modify the Task format on Project change (when a task is changed)
    
    StatusRYGFieldUpdate
    
End Sub

Regular Code Module

Option Explicit
    
Public StatusRYGView                As New clsTskUpdate
Public UpdateViewFlag               As Boolean
Public TskIDChanged                 As Long
    
    
Sub StatusRYGFieldUpdate()
    
    ' this Sub is triggered once a task is modified
    ' if the Field being modifed is related to "Text1"
        
    Dim CurTskID    As Long
    
    Set StatusRYGView.ProjApp = Application
    
    Application.Calculation = pjManual
    Application.ScreenUpdating = False
    
    If UpdateViewFlag Then
        CurTskID = TskIDChanged ' save Row ID
        FormatTask (TskIDChanged) ' call the Sub that formats the cell (send the taskId)
    End If
    
    Application.Calculation = pjAutomatic
    Application.ScreenUpdating = False
    
End Sub
    
'===========================================================
    
Sub FormatTask(TskID)
    
    Dim Tsk         As Task
    
    If UpdateViewFlag Then
        
        SelectTaskField TskID, "Text1", False
        Set Tsk = ActiveCell.Task ' set the Task to current cell's Task
        SelectRow Row:=TskID, RowRelative:=False
        
        ' format entire row first
        Select Case Tsk.Text1 ' Get the Field's used field, not name
            Case "R"
                FontEx CellColor:=7, Color:=0
                FontEx Italic:=False
                
            Case "Complete"
                FontEx Italic:=True 
                FontEx CellColor:=15, Color:=14 ' Background Silver ; font Gray
                
        End Select
                
        ' format "Status" field
        SelectTaskField TskID, "Text1", False
             
        Select Case Tsk.Text1 ' Get the Field's used field, not name
            Case "R"
              ' Font Color:=pjWhite ' Font White
                FontEx Italic:=False
                FontEx CellColor:=1, Color:=7 ' Background Red ; font White
                                                          
            Case "Complete"
                FontEx Italic:=True '  Font Italic
                FontEx CellColor:=15, Color:=14 ' Background Silver ; font Gray
                            
        End Select
    End If ' UpdateViewFlag is True
    
End Sub

clsTskUpdate Class Module

Option Explicit
    
Public WithEvents ProjApp   As Application
    
Private Sub ProjApp_ProjectBeforeTaskChange(ByVal Tsk As Task, ByVal Field As PjField, ByVal NewVal As Variant, Cancel As Boolean)
    
    ' Sub (in "clsTskUpdate" Class) is triggered once a task is modified
    ' if the Field being modifed is related to "Text1"
    ' then the UpdateViewFlag is being raised, and the Tsk.ID (task's row) is saved to TskIDChanged variable
          
    UpdateViewFlag = False
    TskIDChanged = 0
    
    Select Case Field
        Case pjTaskActualFinish
            If Not NewVal Like Format(Tsk.ActualFinish, myDateFormat) Then ' need to modify date format to "dd/mm/yy"
                LastValue = Tsk.ActualFinish
                UpdateViewFlag = True
                TskIDChanged = Tsk.ID
            End If
                                        
        Case pjTaskStart
            If Not NewVal Like Format(Tsk.Start, myDateFormat) Then ' need to modify date format to "dd/mm/yy"
                LastValue = Tsk.Start
                UpdateViewFlag = True
                TskIDChanged = Tsk.ID
            End If
        
        Case pjTaskDuration
            If Not NewVal Like (Tsk.Duration / 480) & "*" Then ' need to divide by 480 (in minutes) and add `*` wild-card for "days"
                LastValue = Tsk.Duration / 480
                UpdateViewFlag = True
                TskIDChanged = Tsk.ID
            End If
            
        Case pjTaskPercentComplete
            If Not NewVal Like Tsk.PercentComplete Then
                LastValue = Tsk.PercentComplete
                UpdateViewFlag = True
                TskIDChanged = Tsk.ID
            End If
            
        ' other possible Case Scenarios in the future
    
    End Select
    
End Sub

Solution

  • Microsoft Project 2007 added a pair of methods, OpenUndoTransaction and CloseUndoTransaction, that create a single undo entry for the user to undo an entire macro.

    Add these methods to procedure StatusRYGFieldUpdate like this:

    Sub StatusRYGFieldUpdate()
    
        Dim CurTskID    As Long
    
        Set StatusRYGView.ProjApp = Application
    
        Application.OpenUndoTransaction "Status RYG Field Update"
        Application.Calculation = pjManual
        Application.ScreenUpdating = False
    
        If UpdateViewFlag Then
            CurTskID = TskIDChanged ' save Row ID
            FormatTask (TskIDChanged) ' call the Sub that formats the cell (send the taskId)
        End If
    
        Application.Calculation = pjAutomatic
        Application.ScreenUpdating = True
        Application.CloseUndoTransaction
    
    End Sub