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

找到了我需要的答案。

hiring_procedure_stage

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

通过VBA弹出项目状态日期表单

3 个答案: