VBAを介してプロジェクトステータスの日付フォームをポップアップ

Question

Project 2016のステータス日付フォームをポップアップするVBAコードは何ですか？リボンのボタンをクリックするのと同じように。コードをStatus Dateにポップアップして、マクロを実行し続けたい。

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、あなたはステータス日付を検証するいずれかの能力を持っていません。ユーザーが日付を入力せずに[OK]または[キャンセル]をクリックするだけで済むことはありません。

このような関数を呼び出すと、有効なステータス日付が入力されたことがわかります。

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