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

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

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

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

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

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

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

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

نمونه مثلا از این تاریخ تا اون تاریخ را که دادیم محاسبه میکنه و تعداد روزشو برات درمیاره و بهت میده
شمسی هم پشتیبانی میکنه ، فقط نمیدونم کبیسه را هم حساب میکنه یا خیر؟؟؟

Print DateDiff ("d", "1390/02/30", "1396/12/08")

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

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

مثلا با این کد زیر برای روز جواب 110 بدست میاد من می خوام مثل این سایت 3 ماه و 19 روز بدست بیارد .

Dim d As String



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



MsgBox (d)

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

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

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

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


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

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

(اینو بگم که این کدها اختصاصی ویژوال بیسیک هست در سایت برنامه نویس نوشتم و کذاشتم و در هیچ کجا حتی سایتهای خارجی پیدا نمیتونی بکنی)

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