|
|
发表于 2020-7-3 19:45:01
|
显示全部楼层
'*/-------------------------------------------------------------
'*/模 块 名:DateFunctions.bas
'*/功 能:字符串到日期及到字符串转换函数
'*/建立日期:2016-09-12
'*/修改日期:
'*/作 者:
'*/联 系：Mnd@sunseaman.com Http://www.sunseaman.com
'*/-------------------------------------------------------------
Option Explicit
'*/-------------------------------------------------------------
'*/函 数 名:DateToString
'*/功 能:标准日期格式转为字符串
'*/返 回 值:String 连续的字符串,如20160912101227
'*/参 数:vStandardDate 标准日期
'*/建立日期:2016-09-12
'*/修改日期:
'*/-------------------------------------------------------------
Public Function DateToString(ByRef vStandardDate As Date) As String 'SerializeDate
Dim strYear As String, strMonth As String, strDay As String
Dim strHour As String, strMinute As String, strSecond As String
strYear = CStr(Year(vStandardDate))
strMonth = CStr(Month(vStandardDate))
strDay = CStr(Day(vStandardDate))
strHour = CStr(Hour(vStandardDate))
strMinute = CStr(Minute(vStandardDate))
strSecond = CStr(Second(vStandardDate))
If CInt(strMonth) < 10 Then _
strMonth = "0" & strMonth
If CInt(strDay) < 10 Then _
strDay = "0" & strDay
If CInt(strHour) < 10 Then _
strHour = "0" & strHour
If CInt(strMinute) < 10 Then _
strMinute = "0" & strMinute
If CInt(strSecond) < 10 Then _
strSecond = "0" & strSecond
DateToString = strYear & strMonth & strDay & strHour & strMinute & strSecond
End Function
'*/-------------------------------------------------------------
'*/函 数 名:StringToDate
'*/功 能:字符串格式的日期转为标准日期格式
'*/返 回 值:Date 标准格式日期,如2016-09-12 10:12:27
'*/参 数:vSerialDate 字符串
'*/建立日期:2016-09-12
'*/修改日期:
'*/-------------------------------------------------------------
Public Function StringToDate(ByRef vSerialDate As String) As Date 'Standardize
Dim strDate As String, strYear As String, strMonth As String, strDay As String
Dim strHour As String, strMinute As String, strSecond As String
strYear = Mid(vSerialDate, 1, 4)
strMonth = Mid(vSerialDate, 5, 2)
strDay = Mid(vSerialDate, 7, 2)
strHour = Mid(vSerialDate, 9, 2)
strMinute = Mid(vSerialDate, 11, 2)
strSecond = Mid(vSerialDate, 13, 2)
strDate = strMonth & "/" & strDay & "/" & strYear & " " & strHour & ":" & strMinute & ":" & strSecond
StringToDate = CDate(strDate)
End Function
'*/-------------------------------------------------------------
'*/函 数 名:CalcDate
'*/功 能:标准日期格式计算
'*/返 回 值:String 起始时间和结束时间计算结果
'*/参 数:strStartDate 起始时间
'*/ strEndDate 结束时间
'*/建立日期:2016-09-12
'*/修改日期:
'*/-------------------------------------------------------------
Public Function CalcDate(ByVal strStartDate As String, ByVal strEndDate As String) As String
Dim lngYears As Long, lngDays As Long, lngHours As Long, lngMinutes As Long, lngSeconds As Long
Dim dblYears As Double, dblDays As Double, dblHours As Double, dblMinutes As Double, dblSeconds As Double
Dim lngTotalSeconds As Long, lngSecondsRemaining As Long
'strStartDate = StringToDate(strStartDate)
' strEndDate = StringToDate(strEndDate)
If CDate(strStartDate) < CDate(strEndDate) Then
lngTotalSeconds = DateDiff("s", CDate(strStartDate), CDate(strEndDate))
Else
lngTotalSeconds = DateDiff("s", CDate(strEndDate), CDate(strStartDate))
End If
lngSecondsRemaining = lngTotalSeconds
lngYears = Fix(lngSecondsRemaining / 31536000)
lngSecondsRemaining = lngSecondsRemaining - (lngYears * 31536000)
lngDays = Fix(lngSecondsRemaining / 86400)
lngSecondsRemaining = lngSecondsRemaining - (lngDays * 86400)
lngHours = Fix(lngSecondsRemaining / 3600)
lngSecondsRemaining = lngSecondsRemaining - (lngHours * 3600)
lngMinutes = Fix(lngSecondsRemaining / 60)
lngSecondsRemaining = lngSecondsRemaining - (lngMinutes * 60)
lngSeconds = lngSecondsRemaining
' CalcDate = CStr(lngYears) & " 年, " _
' & CStr(lngDays) & " 天, " _
' & CStr(lngHours) & " 时, " _
' & CStr(lngMinutes) & " 分, " _
' & CStr(lngSeconds) & " 秒"
CalcDate = IIf(lngDays = 0, "", CStr(lngDays) & "天") _
& IIf(lngHours = 0, "", CStr(lngHours) & "时") _
& IIf(lngMinutes = 0, "", CStr(lngMinutes) & "分") _
& IIf(lngSeconds = 0, "", CStr(lngSeconds) & "秒")
' dblYears = Round(lngTotalSeconds / 31536000, 4)
' dblDays = Round(lngTotalSeconds / 86400, 4)
' dblHours = Round(lngTotalSeconds / 3600, 4)
' dblMinutes = Round(lngTotalSeconds / 60, 4)
' dblSeconds = lngTotalSeconds
' CalcDate = CalcDate & "小数时间:" & vbNewLine _
' & "年: " & CStr(dblYears) & vbNewLine _
' & "天: " & CStr(dblDays) & vbNewLine _
' & "时: " & CStr(dblHours) & vbNewLine _
' & "分: " & CStr(dblMinutes) & vbNewLine _
' & "秒: " & CStr(dblSeconds)
End Function
'是否月份判断
Public Function DaysInMonth(ByVal Month As Integer, ByVal LeapYear As Boolean) As Integer
Select Case Month
Case 1, 3, 5, 7, 8, 10, 12
DaysInMonth = 31
Case 4, 6, 9, 11
DaysInMonth = 30
Case 2
If LeapYear Then
DaysInMonth = 29
Else
DaysInMonth = 28
End If
End Select
End Function
'是否闰年判断
Public Function IsLeapYear(ByVal Year As Integer) As Boolean
If Year Mod 4 = 0 Then
IsLeapYear = True
If Year Mod 100 = 0 And Year Mod 400 <> 0 Then
IsLeapYear = False
End If
End If
End Function
|
|
