Не удается использовать "Отменить" после запуска FormatTask в MSRO Project 2007 MACRO

Префикс: я запускаю код, который изменяет формат строки задачи, основываясь на значении в Text1 поле.

Так что, если я изменю Duration, или же Finish или некоторые другие значения при обновлении расписания, значение Text1 (настраиваемое поле). В результате этого значения я форматирую цвет фона и цвет шрифта.

Проблема: как только я запускаю этот код, я не могу использовать обычное "Отменить", и я не могу получить значения, чтобы вернуться в их предыдущее состояние перед обновлением.

Любая помощь в том, как создать " Custom Undo ", высоко ценится.

Код этого проекта

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

Модуль класса clsTskUpdate

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

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
Другие вопросы по тегам