محاسبه خدمتی سربازی

[maxnet12]

سلام چطور میشه مثلا در یک فرم دوتا جعبه متن باشه جعبه متن اولی تاریخ امروز و جعبه متن دومی تاریخ اعزام سرباز بزنه بعد یک دکمه محاسبه باشد وقتی کلیک شد بیاد محاسبه کنه
که چند سال ، چند ماه، چند روز خدمت کرده.
مثلا یک سال ۲ ماه ۲۹ روز خدمت کرده.

[www.pc3enter.tk]

ببین عزیز یک راه ساده وجود داره اون هم اینکه یک دستوری وجود داره به نام Datediff
حالا کارش چیه

کارش اینکه میاد از شما ۲ تا تاریخ میگیره و اختلاف بین این ۲ تا را بهت میده
حالا نحوه نوشتن چطوره
مثلا

? dateDiff(نوع برسی, تاریخ اول, تاریخ دوم)

در نوع برسی شما میگویید اختلاف بین این ۲ تا را به شکل برسی کنه و چجور جواب بهت بده
که در اینجا چند حالت داره

نمایش ختلاف به صورت سال yyyy
به صورت سال y
به صورت ماه m
به صورت هفته w
به صورت روز d
به صورت ساعت h
به صورت دقیقه n
به صورت ثانیه s

تاریخ اول و دوم هم خودت میدونی

نمونه مثلا از این تاریخ تا اون تاریخ را که دادیم محاسبه میکنه و تعداد روزشو برات درمیاره و بهت میده
شمسی هم پشتیبانی میکنه ، فقط نمیدونم کبیسه را هم حساب میکنه یا خیر؟؟؟
Print DateDiff ("d", "1390/02/30", "1396/12/08")

[www.pc3enter.tk]

و خداوند تشکر را افرید

[maxnet12]

سلام من میخوام مثلا طوری باشه که روز از ماه باشد مثل محاسبه این سایت
https://www.bahesab.ir/time/age (https://www.bahesab.ir/time/age/)

(https://www.bahesab.ir/time/age/) مثلا با این کد زیر برای روز جواب 110 بدست میاد من می خوام مثل این سایت 3 ماه و 19 روز بدست بیارد .
Dim d As String

d = DateDiff("d", "1396/03/19", "1396/07/07")

MsgBox (d)

[www.pc3enter.tk]

سلام
بفرماید یک چیز دمه دستو پا برات نوشتم. البته سریع چون وقت نکردم
امیدوارم کارتو حل نه.


Private Sub Command1_Click()
Print DateToString(1)
Print DateToString(31)
Print DateToString(75)
Print DateToString(299)
Print DateToString(450)
Print DateToString(1000)
End Sub

Private Function DateToString(ByVal Day° As Double) As String
If Day° < 32 Then DateToString = Day° & " Day": Exit Function
Ds = Split(Format(DateSerial(0, 0, Day°), "yyyy/m/ d"), "/")
If 2000 - Ds(0) < 0 Then Ds(0) = Ds(0) - 2000 & " " & "Year" Else Ds(0) = ""
DateToString = Trim(Ds(0) & " " & Ds(1) & " " & "Month" & Ds(2) & " " & "Day")
End Function

[maxnet12]

سلام این خطا میده
Ds = Split(Format(DateSerial(0, 0, Day°), "yyyy/m/ d"), "/")

[www.pc3enter.tk]

عکس بگیر بده
اینجوری متوجه نمیشم


خودم کد را نوشتم ، خطایی نداد؟؟

[www.pc3enter.tk]

البته من دوتا دیگه هم اضافه کردم ولی اینو بگم در هر ۲ تاش خطای دقت ممکنه وجود داره ولی بالایی دقتش بیشتره
و شما فعلا از این کد استفاده نکن دارم روش کار میکنم، نا تعیین صحتش مشخص شه

(اینو بگم که این کدها اختصاصی ویژوال بیسیک هست در سایت برنامه نویس نوشتم و کذاشتم و در هیچ کجا حتی سایتهای خارجی پیدا نمیتونی بکنی)
Private Function Dati(ByVal DAY As Double)
D = 1: M = 1: Y = 1

For a = 1 To DAY ' ايجاد حلقه به تعداد روز وارد شده
D = D + 1 'هر روز را به اضافه يک ميکنه
If M > 6 Then 'برسي براي اينکه تعداد روز تابستان 31 روز هست و زمستان 30 روز
If D = 31 Then M = M + 1: D = 1 'اگر زمستان بود 30 روزه
Else
If D = 32 Then M = M + 1: D = 1 'اگر تابستان بود 31 روزه
End If 'که در اخرش يک روز به ماه اضافه ميکنه

If M = 12 And D = 30 Then Y = Y + 1: M = 1: D = 1 'اگر ماه برابر شد با 12 و تعداد روز شد 30 روز همه را صفر کن و يکي به سال اضافه کن
Next a
Dati = Y & "/" & M & "/" & D 'اخرش چاپ کنه ديگه

End Function

ولی این کد با دقت سال کبیسه محاسبه میکنه
Private Function Dati(ByVal DAY As Double)
D = 0: M = 0: Y = 0

For a = 1 To DAY ' ايجاد حلقه به تعداد روز وارد شده
D = D + 1 'هر روز را به اضافه يک ميکنه

If M > 6 Then 'برسي براي اينکه تعداد روز تابستان 31 روز هست و زمستان 30 روز
If D = 31 Then M = M + 1: D = 1 'اگر زمستان بود 30 روزه
Else
If D = 32 Then M = M + 1: D = 1 'اگر تابستان بود 31 روزه
End If 'که در اخرش يک روز به ماه اضافه ميکنه

کبيسه = کبيسه + 1
If کبيسه = 4 Then 'اين کد با در نظر کبيسه حساب ميشه
If M = 12 And D = 31 Then Y = Y + 1: M = 1: D = 1: کبيسه = 0
Else
If M = 12 And D = 30 Then Y = Y + 1: M = 1: D = 1 'اگر ماه برابر شد با 12 و تعداد روز شد 30 روز همه را صفر کن و يکي به سال اضافه کن
End If

Next a
Dati = Y & "/" & M & "/" & D 'اخرش چاپ کنه ديگه
End Function