كسر مدت زمان مشخص از يك تاريخ

[khosravani]

با سلام دوستان لطفا راهنمائي نمايند. من ميخواهم يك مدت زمان مشخص را مثلا 2 سال و 5 ماه و 22 روز را از تاريخ جاري سيستم كه شمسي است كم كنم و تاريخ جديدي را بدست آورم . در صورت امكان راهنمائي كنيد. با تشكر

[sib_data]

اگر تاريخ را تبديل ميكنيد به شمسي بايد از ماژول تبديل خودتون استفاده كنيد و ميزان مشخص را مثل يك عدد كم كنيد. ميتونيد تاريخ جاري را به لاتين تبديل كنيد و ميزان مورد نظر را كم كنيد و بعد تبديل به شمسي كنيد. در هر صورت كسر يك ميزان مشخص از تاريخ شبيه به كسر اعداد است.

[مهدی قربانی]

سلام
دوست عرير ظاهراً خيلي جستجو نكرديد قبلاً هم خدمت يكي از دوستان عرض كرده بودم ماجولهاي تاريخ شمسي آقاي آزادي و همينطور Jalali كه هردو هم در همين بخش موجود هستند تابعي براي عمليات مورد نظر شما دارن كه مي تونيد از اونها استفاده كنيد .

[khosravani]

جناب آقاي قرباني ضمن تشكر از پاسختان تابع مربوطه را نتوانستم اجرا كنم در صورت امكان بيشتر راهنمائي فرمائيد.البته منظورم بيشتر قسمت كسر از تاريخ ميباشد.

[مهدی قربانی]

سلام
اين نمونه با استفاده از ماجول آقاي آزادي عمليات مورد نظر شما رو انجام مي ده :

Function SubtractDay(ByVal F_Date As Long, ByVal Subtract As Long) As Long
'به تعداد روز معيني از يک تاريخ کم کرده و تاريخ حاصله را ارائه ميکند
Dim K, M, S, R, Days As Byte

R = Rooz(F_Date)
M = Mah(F_Date)
S = Sal(F_Date)
K = Kabiseh(S)

'تبديل روز به عدد 1 جهت ادامه محاسبات و يا اتمام محاسبه
If Subtract >= R - 1 Then
Subtract = Subtract - (R - 1)
R = 1
Else
R = R - Subtract
Subtract = 0
End If

While Subtract > 0
K = Kabiseh(S - 1) 'کبيسه: 1 و غير کبيسه: 0
Days = MahDays(IIf(M >= 2, S, S - 1), IIf(M >= 2, M - 1, 12)) 'تعداد روزهاي ماه قبلي
Select Case Subtract
Case Is < Days
'اگر تعداد روزهاي کاهش کمتر از يک ماه باشد
R = Days - Subtract + 1
Subtract = 0
If M >= 2 Then
M = M - 1
Else
S = S - 1
M = 12
End If
Case Days To IIf(K = 0, 365, 366) - 1
'اگر تعداد روزهاي کاهش بيشتر از يک ماه و کمتر از يک سال باشد
Subtract = Subtract - Days
If M >= 2 Then
M = M - 1
Else
S = S - 1
M = 12
End If
Case Else
'اگر تعداد روزهاي کاهش بيشتر از يک سال باشد
S = S - 1
Subtract = Subtract - IIf(K = 0, 365, 366)
End Select
Wend
SubtractDay = (S * 10000) + (M * 100) + (R)

End Function