在一个时间段内 如何知道 有几个 节假日（像星期六、星期天还有公共的假日）还有 这些 节假日 到底是 那月那天！在线等！！！

Question

具体是这样的：
在窗体中有 两个 复选框（CheckBox） 和两个 时间控件（DTPicker）。
选择CheckBox1时 只有DTPicker1可以选择时间，选择CheckBox2时 只有DTPicker2可以选择时间，当两个CheckBox同时选择时 就会出现一个时间段。
第一个问题：
当选择一个DTPicker的时候，要知道 这一天是否 是节假日具体是 星期六、星期天还是 其它 公共的假日或者 不是节假日。
第二个问题：
当同时选择两个DTPicker的时候，要知道 这在这个时间段内 有几个 星期六、星期天还是 其它 公共的假日 而且 分别要知道 这些 假日 是那天。

Answer 1

第一个～
要知道具体的节假日只能自己写节假日列表来判断Private Sub DTPicker1_Change()
    Dim tS As String
    
    tS = "日一二三四五六"
    
    With DTPicker1
        Me.Caption = .Value & " 星期" & Mid(tS, .DayOfWeek, 1)
    End With
End Sub

Answer 2

第二个也得根据节假日列表来判断可以用DateDiff来获得间隔时间～
Private Sub DTPicker2_Change()
    Me.Caption = "相隔 " & DateDiff("d", DTPicker1.Value, DTPicker2.Value) & " 天"
End Sub

Answer 3

1.判断选择日期是星期X
Private Sub Command1_Click()
    MsgBox Weekday(DTPicker1.Value, vbMonday)
End Sub
'节假日,最好声明一个数组,存放固定的节假日,或者灵活的节假日,然后再对比2.
Private Sub Command2_Click()
    Dim a As Date, b As Date
    a = Date
    b = CDate("2005-1-1")
    
    While a < b
        a = a + 1
        If Weekday(a, vbMonday) = 6 Or Weekday(a, vbMonday) = 6 Or IsOtherRestDay(a)=true Then
            Debug.Print a
        End If
    Wend
End Subprivate function IsOtherRestDay(dDate as Date) as Boolean
    '事先定义的数组内循环判断dDate是否在数组内
end function

Answer 4

直接看这个的源文件：http://txt.mop.com/static/calendarCN.htm里面就有个足够完整的节日列表
整理下就可以用了～

Answer 5

1
星期六日以外的法定假日，要靠查表的方法来解决。
Dim HoliDay As Date
Dim i As Integer
For i = 0 To Year(DTPicker2) - Year(DTPicker1) '解决跨年度问题
  rsHoliday.MoveFirst
  Do Until rsHoliday.EOF
    HoliDay = Year(DTPicker1)+i & (rsHoliday!mMonth) & (rsHoliday!mDay)
    If HoliDay >=  DTPicker1 And HoliDay <=  DTPicker2 Then
       MsgBox "这段时期包含" & Year(DTPicker1)+i & "年的" & rsHoliday!DayName
    End If
    rsHoliday.MoveNext
  Loop
Next i2
判断星期六、日
单独的一天，用 Weekday 函数：
If Weekday(DTPicker1.Value, vbMonday) > 5一个日期段，用 DateDiff
n ＝ DateDiff("WW", DTPicker1, DTPicker2)
If Weekday(DTPicker1.Value, vbMonday) = 7 Then n = n + 1以上是判断星期日的个数：
DateDiff 函数，如果 interval 是“周”(ww)，则 DateDiff 函数返回两日期间的“日历周”数。由计算 date1 与 date2 之间星期日的个数而得。如果 date2 刚好是星期日，则 date2 也会被加进 DateDiff 的计数结果中；但不论 date1 是否为星期日，都不将它算进去。计算星期六的方法，可以仿此：
n ＝ DateDiff("WW", DTPicker1, DTPicker2, vbSaturday)
If Weekday(DTPicker1.Value, vbMonday) = 6 Then n = n + 1

Answer 6

To AprilSong(X) :
   ================================================
   http://txt.mop.com/static/calendarCN.htm
   ================================================
   
   这个日历做得很棒，不知哪里有类似这样的源代码。

Answer 7

'***************************************************************
'【创 建 人】crystal
'【创建日期】2004-12-22
'【修改日期】2004-11-24
'【功能描述】计算一个时间段内有几个星期六和星期日，并且计算出其准确的日子
'【入口参数】
'【返 回 值】 一个数组
'【备   注】
'***************************************************************
Private Sub SundayAndSaturday()
    Dim SSI As Integer
    Dim FirstDate As Date   ' 声明变量。
    Dim strSunday  As Date
    Dim strSaturday  As Date    SundayN = DateDiff("WW", dtp1, dtp2)
    If Weekday(dtp1.Value, vbMonday) = 7 Then SundayN = SundayN + 1
    
    SaturdayN = DateDiff("WW", dtp1, dtp2, vbSaturday)
    If Weekday(dtp1.Value, vbMonday) = 6 Then SaturdayN = SaturdayN + 1
    
    If SundayN > 0 Then
        FirstDate = Format(dtp1.Value)
        If Weekday(FirstDate, vbMonday) = 7 Then
            strSunday = FirstDate
            For SSI = 1 To SundayN
                If SSI = 1 Then
                    ReDim arrSunday(SundayN - 1)
                    arrSunday(SSI - 1) = strSunday
                Else
                    strSunday = DateAdd("d", 7, strSunday)
                    If strSunday < Format(dtp2.Value) Then
                        ReDim Preserve arrSunday(SundayN - 1)
                        arrSunday(SSI - 1) = strSunday
                    End If
                End If
            Next 'SSI
        Else
            Select Case Weekday(FirstDate, vbMonday)
                Case 1
                    strSunday = DateAdd("d", 6, FirstDate)
                Case 2
                    strSunday = DateAdd("d", 5, FirstDate)
                Case 3
                    strSunday = DateAdd("d", 4, FirstDate)
                Case 4
                    strSunday = DateAdd("d", 3, FirstDate)
                Case 5
                    strSunday = DateAdd("d", 2, FirstDate)
                Case 6
                    strSunday = DateAdd("d", 1, FirstDate)
            End Select
            
            For SSI = 1 To SundayN
                If SSI = 1 Then
                    If strSunday < Format(dtp2.Value) Then
                        ReDim arrSunday(SundayN - 1)
                        arrSunday(SSI - 1) = strSunday
                    Else
                        Exit For
                    End If
                Else
                    strSunday = DateAdd("d", 7, strSunday)
                    If strSunday < Format(dtp2.Value) Then
                        ReDim Preserve arrSunday(SundayN - 1)
                        arrSunday(SSI - 1) = strSunday
                    End If
                End If
            Next 'SSI
        End If
    End If    If SaturdayN > 0 Then
        FirstDate = Format(dtp1.Value)
        If Weekday(FirstDate, vbMonday) = 6 Then
            strSaturday = FirstDate
            For SSI = 1 To SaturdayN
                If SSI = 1 Then
                    If strSaturday < Format(dtp2.Value) Then
                        ReDim arrSaturday(SaturdayN - 1)
                        arrSaturday(SSI - 1) = strSaturday
                    Else
                        Exit For
                    End If
                Else
                    strSaturday = DateAdd("d", 7, strSaturday)
                    If strSaturday < Format(dtp2.Value) Then
                        ReDim Preserve arrSaturday(SaturdayN - 1)
                        arrSaturday(SSI - 1) = strSaturday
                    End If
                End If
            Next 'SSI
        Else
            Select Case Weekday(FirstDate, vbMonday)
                Case 1
                    strSaturday = DateAdd("d", 5, FirstDate)
                Case 2
                    strSaturday = DateAdd("d", 4, FirstDate)
                Case 3
                    strSaturday = DateAdd("d", 3, FirstDate)
                Case 4
                    strSaturday = DateAdd("d", 2, FirstDate)
                Case 5
                    strSaturday = DateAdd("d", 1, FirstDate)
                Case 7
                    strSaturday = DateAdd("d", 6, FirstDate)
            End Select
            For SSI = 1 To SaturdayN
                If SSI = 1 Then
                    If strSaturday < Format(dtp2.Value) Then
                        ReDim arrSaturday(SaturdayN - 1)
                        arrSaturday(SSI - 1) = strSaturday
                    Else
                        Exit For
                    End If
                Else
                    strSaturday = DateAdd("d", 7, strSaturday)
                    If strSaturday < Format(dtp2.Value) Then
                        ReDim Preserve arrSaturday(SaturdayN - 1)
                        arrSaturday(SSI - 1) = strSaturday
                    End If
                End If
            Next 'SSI
        End If
    End If
End Sub