البته من دوتا دیگه هم اضافه کردم ولی اینو بگم در هر ۲ تاش خطای دقت ممکنه وجود داره ولی بالایی دقتش بیشتره
و شما فعلا از این کد استفاده نکن دارم روش کار میکنم، نا تعیین صحتش مشخص شه
(اینو بگم که این کدها اختصاصی ویژوال بیسیک هست در سایت برنامه نویس نوشتم و کذاشتم و در هیچ کجا حتی سایتهای خارجی پیدا نمیتونی بکنی)
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
پاسخ با نقل قول
