宏运行后如何"Undo"？

Question

我正在运行一个代码，该代码根据Text1字段中的值更改任务行的格式。

如果我在更新计划时更改Duration、Finish或其他一些值，则 Text1(自定义字段(的值也会被修改。由于该值，我正在格式化背景颜色和字体颜色。

运行此代码后，我无法使用常规的"撤消"，因此无法让值返回到以前的状态。

如何创建">自定义撤消"？

此项目代码

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

常规代码模块

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

clsTsk更新类模块

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

Answer 1

Microsoft Project

2007 添加了一对方法，OpenUndoTransaction 和 CloseUndoTransaction，它们为用户创建一个撤消条目来撤消整个宏。

将这些方法添加到过程 StatusRYGFieldUpdate 中，如下所示：

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