'================================================================================
'##### Преобразует дату в басурманский формат
'
'Sub test_FnDateRu_En()
' strDate = "7/18/2031"
'' strDateNew = FnDateRu_En(strDate)
' strDateNew = FnDateEn_Ru(strDate)
'End Sub
'--------------------------------------------------------------------------------
Function FnDateRu_En(ByVal strDate As String) As String
If Len(strDate) = 0 Then strDate = Now
m = Split(strDate, ".", -1, vbBinaryCompare)
If Left(m(0), 1) = 0 Then m(0) = Right(m(0), Len(m(0) - 1))
If Left(m(1), 1) = 0 Then m(1) = Right(m(1), Len(m(1) - 1))
FnDateRu_En = m(1) & "/" & m(0) & "/" & Left(m(2), 4)
End Function
'================================================================================
'================================================================================
'##### Преобразует из басурманского формата
'
'--------------------------------------------------------------------------------
Function FnDateEn_Ru(ByVal strDate As String) As String
m = Split(strDate, "/", -1, vbBinaryCompare)
If Len(m(0)) = 1 Then m(0) = "0" & m(0)
If Len(m(1)) = 1 Then m(1) = "0" & m(1)
FnDateEn_Ru = m(1) & "." & m(0) & "." & m(2)
End Function
'================================================================================
'================================================================================
'Минимальное-максимальное значение даты в массиве
'пееременные дат объявить в модуле
'Dim dDateVal As Date, dDateMin As Date, dDateMax As Date
'Dim strDateMin As String, strDateMax As String, strDate As String
'bln_CalculateDatePSFV-датуPSFV
'--------------------------------------------------------------------------------------------------
Sub Date_Min_Max(ByVal ar As Variant, _
ByVal bln_CalculateDatePSFV As Boolean)
If IsArray(ar) Then
dDateMin = Format(ar(LBound(ar), UBound(ar)), "DD.MM.YYYY")
dDateMax = dDateMin
Select Case bln_CalculateDatePSFV
Case True
For j = LBound(ar, 2) To UBound(ar, 2)
If Format(ar(0, j), "hh:mm:ss") < "07:00:00" Then
dDateVal = Format(CDate(ar(0, j)) - 1, "DD.MM.YYYY")
Else
dDateVal = Format(ar(0, j), "DD.MM.YYYY")
End If
If dDateVal < dDateMin Then dDateMin = dDateVal
If dDateVal > dDateMax Then dDateMax = dDateVal
Next j
Case False
For j = LBound(ar, 2) To UBound(ar, 2)
dDateVal = Format(ar(0, j), "DD.MM.YYYY")
If dDateVal < dDateMin Then dDateMin = dDateVal
If dDateVal > dDateMax Then dDateMax = dDateVal
Next j
End Select
If IsDate(dDateMin) Then strDateMin = fin_DateSQL(dDateMin)
If IsDate(dDateMax) Then strDateMax = fin_DateSQL(dDateMax)
End If
End Sub
'===============================================================================
'============================================================================================
'##### 'Поиск максимального(минимального) занчения даты
'дата для SQL
Function funSqlDate(ByVal dDate As Variant) As String
Dim strD As String, strM As String, strY As String
strD = Format(dDate, "DD")
strM = Format(dDate, "MM")
strY = Format(dDate, "YYYY")
funSqlDate = strM & "/" & strD & "/" & strY
End Function
'--------------------------------------------------------------------------------------------
Function fundDate(ByVal blnMax As Boolean, _
ByVal aDate As Variant) As Date
Dim iDate As Long, dDate As Date
Dim intLbound As Integer: intLbound = LBound(aDate)
fundDate = CDate(Trim(aDate(intLbound, LBound(aDate))))
Select Case blnMax
Case True:
For iDate = LBound(aDate) To UBound(aDate, 2)
If Len(Trim(aDate(intLbound, iDate))) > 0 Then
dDate = CDate(Trim(aDate(intLbound, iDate)))
If dDate > fundDate Then fundDate = dDate
End If
Next iDate
Case False:
For iDate = LBound(aDate) To UBound(aDate, 2)
If Len(Trim(aDate(intLbound, iDate))) > 0 Then
dDate = CDate(Trim(aDate(intLbound, iDate)))
If dDate < fundDate Then fundDate = dDate
End If
Next iDate
End Select
End Function
'============================================================================================
