主题：[求助]工作日期

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:工作日期.foxdb

Select Case e.DataCol.Name
    Case "开始日期","天数"
        Dim dr As DataRow
        dr = e.DataRow
        If dr.IsNull("开始日期") OrElse dr.IsNull("天数") Then
            dr("结束日期") = Nothing
        Else
            Dim c As Integer = 0
            Dim d As Date
            Dim i As Integer = 1
            Dim drs = DataTables("法定假期").Select("")
            Dim lst1 As new List(of Date)
            Dim lst2 As new List(of Date)
            For Each cdr As DataRow In drs
                If cdr("名称") = "上班" Then
                    For m As Integer = 1 To cdr("天数")
                        lst2.Add(cdr("开始日期").AddDays(m-1))
                    Next
                Else
                    For m As Integer = 1 To cdr("天数")
                        lst1.Add(cdr("开始日期").AddDays(m-1))
                    Next
                End If
            Next
            Dim tshu As Integer = dr("天数")
            d = dr("开始日期").adddays(1)
            Do While i < tshu
                d = d.AddDays(1)
                If d.DayOfWeek = 0 OrElse d.DayOfWeek = 6 Then
                    If lst2.Contains(d) Then
                        i = i + 1
                    End If
                Else
                    If lst1.Contains(d) = False Then
                        i = i + 1
                    End If
                End If
            Loop
            dr("结束日期") = d
        End If
End Select

datacolchanging事件，细节自己调整

 

Select Case e.DataCol.name
    Case "任务2_结束日期"
        Dim d1 As Date = e.DataRow("结束日期")
        Dim d2 As Date = e.NewValue
        If e.NewValue <> Nothing
            If d2 < d1 Then
                msgbox("日期不能小于结束日期")
                e.cancel = True
            Else
                Dim fdr As DataRow = DataTables("法定假期").find("开始日期 <= #" & e.NewValue & "#", "开始日期 desc")
                If fdr IsNot Nothing Then
                    If fdr("开始日期") <= e.NewValue AndAlso cdate(fdr("开始日期")).AddDays(fdr("天数")) >= e.newvalue AndAlso fdr("名称") <> "上班" Then
                        msgbox(fdr("名称"))
                        e.cancel = True
                        Return
                    End If
                End If
                Dim wday = e.NewValue.dayofweek
                If wday = 6 OrElse wday = 0 Then
                    If fdr Is Nothing Then
                        msgbox("周末")
                        e.cancel = True
                    Else
                        If fdr("开始日期") <= e.NewValue AndAlso cdate(fdr("开始日期")).AddDays(fdr("天数")) >= e.newvalue AndAlso fdr("名称") <> "上班" Then
                            msgbox("周末")
                            e.cancel = True
                        End If
                    End If
                End If
               
            End If
        End If
End Select

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:再问.foxdb

'不含任务1_开始日期
Select Case e.DataCol.Name
    Case "任务1_开始日期","档次"
        Dim dr As DataRow
       
        dr = e.DataRow
        If dr.IsNull("任务1_开始日期") Then
            dr("任务1_结束日期") = Nothing
            dr("任务2_结束日期") = Nothing
            dr("任务3_结束日期") = Nothing
            dr("任务4_结束日期") = Nothing
        Else
           
            Dim ts1 As Integer = DataTables("任务所须天数").find("任务名称 = '任务1' and  档次类型='" & e.DataRow("档次") & "'")("所需工作日")
            Dim ts2 As Integer = DataTables("任务所须天数").find("任务名称 = '任务2'")("所需工作日")
            Dim ts3 As Integer = DataTables("任务所须天数").find("任务名称 = '任务3'")("所需工作日")
            Dim ts4 As Integer = DataTables("任务所须天数").find("任务名称 = '任务4'")("所需工作日")
            dr("任务1_所需工作日") = ts1
            dr("任务2_所需工作日") = ts2
            dr("任务3_所需工作日") = ts3
            dr("任务4_所需工作日") = ts4
            Dim tsf As Integer = ts1+ts2+ts3+ts4
            Dim c As Integer = 0
            Dim d As Date
            Dim i As Integer = 1
            Dim drs = DataTables("法定假期").Select("")
            Dim lst1 As new List(of Date)
            Dim lst2 As new List(of Date)
            For Each cdr As DataRow In drs
                If cdr("名称") = "上班" Then
                    For m As Integer = 1 To cdr("天数")
                        lst2.Add(cdr("开始日期").AddDays(m-1))
                    Next
                Else
                    For m As Integer = 1 To cdr("天数")
                        lst1.Add(cdr("开始日期").AddDays(m-1))
                    Next
                End If
            Next
            'Dim tsf As Integer = dr("天数")
            d = dr("任务1_开始日期").adddays(1)
            Do While i < ts1
                d = d.AddDays(1)
                If d.DayOfWeek = 0 OrElse d.DayOfWeek = 6 Then
                    If lst2.Contains(d) Then
                        i = i + 1
                    End If
                Else
                    If lst1.Contains(d) = False Then
                        i = i + 1
                    End If
                End If
            Loop
            dr("任务1_结束日期") = d
           
            tsf = ts1+ts2
            d = dr("任务1_开始日期").adddays(1)
            i = 1
            Do While i < tsf
                d = d.AddDays(1)
                If d.DayOfWeek = 0 OrElse d.DayOfWeek = 6 Then
                    If lst2.Contains(d) Then
                        i = i + 1
                    End If
                Else
                    If lst1.Contains(d) = False Then
                        i = i + 1
                    End If
                End If
            Loop
            dr("任务2_结束日期") = d
           
            tsf = ts1+ts3+ts2
            d = dr("任务1_开始日期").adddays(1)
            i = 1
            Do While i < tsf
                d = d.AddDays(1)
                If d.DayOfWeek = 0 OrElse d.DayOfWeek = 6 Then
                    If lst2.Contains(d) Then
                        i = i + 1
                    End If
                Else
                    If lst1.Contains(d) = False Then
                        i = i + 1
                    End If
                End If
            Loop
            dr("任务3_结束日期") = d
           
            tsf = ts1+ts4+ts3+ts2
            d = dr("任务1_开始日期").adddays(1)
            i = 1
            Do While i < tsf
                d = d.AddDays(1)
                If d.DayOfWeek = 0 OrElse d.DayOfWeek = 6 Then
                    If lst2.Contains(d) Then
                        i = i + 1
                    End If
                Else
                    If lst1.Contains(d) = False Then
                        i = i + 1
                    End If
                End If
            Loop
            dr("任务4_结束日期") = d
           
        End If
End Select

计算天数，参考代码

 

Select Case e.DataCol.Name
    Case "修改日期"
        Dim dr As DataRow
        dr = e.DataRow
        If dr.IsNull("修改日期")  Then
            dr("进度") = Nothing
        Else
            Dim c As Integer = 0
            Dim d As Date
            Dim drs = DataTables("法定假期").Select("")
            Dim lst1 As new List(of Date)
            Dim lst2 As new List(of Date)
            For Each cdr As DataRow In drs
                If cdr("名称") = "上班" Then
                    For m As Integer = 1 To cdr("天数")
                        lst2.Add(cdr("开始日期").AddDays(m-1))
                    Next
                Else
                    For m As Integer = 1 To cdr("天数")
                        lst1.Add(cdr("开始日期").AddDays(m-1))
                    Next
                End If
            Next
            d = dr("修改日期")
            Dim i As Integer = 0
            Do While d <= Date.Today
                If d.DayOfWeek = 0 OrElse d.DayOfWeek = 6 Then
                    If lst2.Contains(d) Then
                        i = i + 1
                    End If
                Else
                    If lst1.Contains(d) = False Then
                        i = i + 1
                    End If
                End If
                d = d.AddDays(1)
            Loop
            dr("进度") = i
        End If
End Select

参考15楼代码啊。Date.Today改成你的结束日期即可。