通過VBA彈出項目狀態日期表格

Question

在Project 2016中彈出狀態日期表單的VBA代碼是什麼？就像點擊功能區上的按鈕一樣。我希望代碼彈出狀態日期，然後繼續運行宏。

Answer 1

Dim NewStatusDate 
NewStatusDate = InputBox("Please enter a new Status Date value") 
If NewStatusDate <> "" Then ' Check it's not empty 
    ThisProject.StatusDate = NewStatusDate 
End If 

你可能想驗證給定的值是一個日期，你可能需要的任何其他東西，但此時會彈出一個輸入框，並允許您更改項目的狀態日期。

Answer 2

找到了我需要的答案。

ActiveProject.CommandBars.ExecuteMso ("StatusDate")

Answer 3

雖然你可以彈出項目信息選項卡這一行：Application.ProjectSummaryInfo，你沒有任何驗證狀態日期的能力。沒有什麼可以阻止用戶在沒有輸入日期的情況下單擊「確定」或「取消」。

最好調用這樣的函數，以便知道輸入了有效的狀態日期。

Private Sub GetStatusDate() 

    Dim CurStatusDate As Variant 
    CurStatusDate = ActiveProject.StatusDate 

    ' set a default, suggested status date 
    Dim SuggestedDate As Date 
    SuggestedDate = Date 

    Dim StatusDate As Date 

    If VarType(CurStatusDate) = vbDate And CDate(CurStatusDate) >= SuggestedDate Then 
     StatusDate = CDate(CurStatusDate) 
    Else 
     Dim Msg As String 
     Msg = vbCrLf & "Suggested status date:" & vbTab & SuggestedDate 
     If VarType(CurStatusDate) = vbDate Then 
      Msg = "Current status date:" & vbTab & Format(CurStatusDate, "m/d/yyyy") & Msg 
     Else 
      Msg = "Current status date:" & vbTab & Format(CurStatusDate, "m/d/yyyy") & Msg 
     End If 

     Dim NewDate As String 
     NewDate = InputBox(Msg, "Enter the project status date", SuggestedDate) 

     If Len(NewDate) = 0 Then 
      StatusDate = SuggestedDate 
     ElseIf Not IsDate(NewDate) Then 
      StatusDate = SuggestedDate 
      Msg = "Your entry of " & NewDate & " was not recognized as a valid date." & _ 
       vbCrLf & StatusDate & " will be used as the status date." 
      MsgBox Msg, vbOKOnly + vbCritical, "Invalid entry" 
     Else 
      StatusDate = CDate(NewDate) 
     End If 
     ActiveProject.StatusDate = StatusDate 
    End If 

End Sub