1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
| Private Sub CommandButton2_Click()
MsgBox deter_borne_trim(Range("A1").Value, 1) & _
vbCrLf & deter_borne_trim(Range("A2").Value, -1)
End Sub
Private Function deter_borne_trim(D As Date, sens As Integer) As Date
Y = Year(D)
Select Case sens
Case 1
refs = Array(DateSerial(Y, 1, 1), DateSerial(Y, 4, 1), DateSerial(Y, 7, 1), DateSerial(Y, 10, 1), DateSerial(Y + 1, 1, 1))
For i = 0 To UBound(refs)
If D <= refs(i) Then
deter_borne_trim = refs(i)
Exit For
End If
Next
Case -1
refs = Array(DateSerial(Y, 12, 31), DateSerial(Y, 9, 30), DateSerial(Y, 6, 30), DateSerial(Y, 3, 31), DateSerial(Y - 1, 12, 31))
For i = 0 To UBound(refs)
If D >= refs(i) Then
deter_borne_trim = refs(i)
Exit For
End If
Next
End Select
End Function |
Partager