|
本帖最后由 todaynew 于 2010-10-11 16:17 编辑
todaynew 老师谢谢帮助,您在11楼放置实例第三个日历
请问老师能否将范例中数据提取出来。谢谢!
yanwei82123300 发表于 2010-10-11 14:36
11楼的第三例与15楼的示例算法一样,具体运用大体可以如下:
Function Calendar(Myyear As Long) As String
'功能:每季度按445周的的工厂日历
'参数:Myyear--财政年度
'示例:Me.日历.RowSource = "月度;首日;末日;" & Calendar(Me.年度.Value)
Dim mydate As Date
Dim str As String
Dim i As Long, j As Long, m
mydate = DateSerial(Myyear - 1, 10, 1)
str = str & 1 & ";" & mydate & ";"
If Weekday(mydate, vbMonday) <> 6 Then
mydate = DateAdd("d", 21, mydate)
For j = 1 To 7
If Weekday(mydate, vbMonday) = 5 Then
Exit For
End If
mydate = DateAdd("d", 1, mydate)
Next
Else
mydate = DateAdd("d", 20, mydate)
End If
str = str & mydate & ";"
m = 0
For i = 1 To 4
For j = 1 To 3
m = m + 1
If m = 12 Then Exit For
If m <> 1 Then
str = str & m & ";" & DateAdd("d", 1, mydate) & ";"
If j <> 3 Then
mydate = DateAdd("d", 28, mydate)
Else
mydate = DateAdd("d", 35, mydate)
End If
str = str & mydate & ";"
End If
Next
If m = 12 Then Exit For
Next
str = str & m & ";" & DateAdd("d", 1, mydate) & ";" & DateSerial(Myyear, 9, 30)
Calendar = str
End Function
Function mnth(mydate As Date) As Variant
'功能:按日历日期返回财政日历数组
'参数:mydate--日历日期
'示例:
'Dim A
'If IsDate(Me.日历日期) = True Then
'A=mnth(Me.日历日期.Value)
'Me.财政年度.Value = A(0)
'Me.财政月度.Value =A(1)
'Me.首日.Value = A(2)
'Me.末日.Value = A(3)
'Else
'MsgBox "日历日期不能为空!"
'End If
Dim str As String
Dim myMonth As Long
Dim A
Dim B(4)
Dim date0 As Date, date1 As Date
Dim i As Long
If Month(mydate) >= 10 And Month(mydate) <= 12 Then
str = Calendar(Year(mydate) + 1)
B(0) = Year(mydate) + 1
Else
str = Calendar(Year(mydate))
B(0) = Year(mydate)
End If
A = Split(str, ";")
For i = 0 To UBound(A, 1) Step 3
myMonth = A(i)
date0 = CDate(A(i + 1))
date1 = CDate(A(i + 2))
If CDate(mydate) >= date0 And CDate(mydate) <= date1 Then
B(2) = date0: B(3) = date1
Exit For
End If
Next
B(1) = myMonth
mnth = B
End Function
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|