قسمتی از ماژول تبدیل میلادی به شمسی و اختلاف دو تاریخ شمسی

کپسول تامیفلو (تامی فلو) 45 میلی گرم | TAMIFLU Capsule 45 mg

TAMIFLU-Capsule-4... ‹ www.darooyab.ir

موارد مصرف کپسول تامیفلو (تامی فلو) 45 میلی گرم. ضد ویروس(مهارکننده نورآمینیداز ویروس آنفلوآنزا). الف- درمان عفونت حاد انفلوانزای نوع Aو B بدون عارضه

در تابع Shamsi در دو متغیر تاریخ شمسی و میلادی مبنا ذخیره میشود ، با تابع DateDiff خود اکسس اختلاف روزهای دو تاریخِ روز و تاریخ میلادی مبنا محاسبه شده و اگر بزرگتر از صفر بود به تابع AddDay پاس داده میشود تا این تعداد روز بدست آمده به تاریخ شمسی مبنا اضافه شود هر چقدر تاریخ مبنا با تاریخ روز نزدیک تر شود جواب سریعتر پاسخ داده میشود یعنی هر چند سال یکبار باید تاریخ مبناها را عوض کنید.

Public Function shamsi() As Long
Dim Shamsi_Mabna As Long
Dim Miladi_mabna As Date
Dim Dif As Long
Shamsi_Mabna = 13791012
Miladi_mabna = #1/1/2001#
Dif = DateDiff("d", Miladi_mabna, Date)
If Dif < 0 Then
MsgBox "?!!!"
Else
shamsi = AddDay(Shamsi_Mabna, Dif)
End If
End Function

در تابع زیر کبیسه بودن سال شمسی را مشخص میکند البته از Mod 4 برای تمام سال های شمسی از ابتدا تا ... نمی توان استفاده کرد چون سال کبیسه ۵ ساله هم وجود دارد.

برای تشخیص سال‌های کبیسه در گاه‌شماری رسمی ایران شیوه کاملاً یکنواختی وجود ندارد. برای سال‌های ۱۲۴۴ تا ۱۳۴۲ چنانچه باقی‌ماندهٔ حاصل تقسیم سال مورد نظر بر عدد ۳۳، یکی از اعداد (۱، ۵، ۹، ۱۳، ۱۷، ۲۱، ۲۶ و ۳۰) باشد آن سال کبیسه خواهد بود.و برای سال‌های اخیر (سال‌های ۱۳۴۳ تا ۱۴۷۲)، به‌جای ۲۱، باقی‌ماندهٔ ۲۲ ملاک خواهد بود. برای دیگر سال‌ها و دوره‌ها نیز به مراتب تفاوت‌هایی در اعداد هشتگانه فوق وجود دارد. برای نمونه سال ۱۳۹۱ سالی کبیسه است چراکه باقی‌ماندهٔ تقسیم آن بر عدد ۳۳ برابر عدد ۵ است.

Public Function Kabiseh(ByVal OnlySal As Variant) As Integer

Kabiseh = 0

If OnlySal >= 1375 Then

If (OnlySal - 1375) Mod 4 = 0 Then

Kabiseh = 1

Exit Function

End If

ElseIf OnlySal <= 1370 Then

If (1370 - OnlySal) Mod 4 = 0 Then

Kabiseh = 1

Exit Function

End If

End If

End Function

تابع زیر دو تاریخ را میگیرد و تعداد روزهای بین آنها را باز می گرداند البته بهتر و کمتر از اینهم می توان نوشت.

Public Function Diff(ByVal FromDate As Long, ByVal To_Date As Long) As Long

Dim Tmp As Long

Dim s1, m1, r1, s2, m2, r2 As Integer

Dim Sumation As Single

Dim Flag As Boolean

Flag = False

If FromDate = 0 Or IsNull(FromDate) = True Or To_Date = 0 Or IsNull(To_Date) = True Then

Diff = 0

Exit Function

End If

If FromDate > To_Date Then

Flag = True

Tmp = FromDate

FromDate = To_Date

To_Date = Tmp

End If

r1 = Rooz(FromDate)

m1 = mah(FromDate)

s1 = Sal(FromDate)

r2 = Rooz(To_Date)

m2 = mah(To_Date)

s2 = Sal(To_Date)

Sumation = 0

Do While s1 < s2 - 1 Or (s1 = s2 - 1 And (m1 < m2 Or (m1 = m2 And r1 <= r2)))

If Kabiseh((s1)) = 1 Then

If m1 = 12 And r1 = 30 Then

Sumation = Sumation + 365

r1 = 29

Else

Sumation = Sumation + 366

End If

Else

Sumation = Sumation + 365

End If

s1 = s1 + 1

Loop

Do While s1 < s2 Or m1 < m2 - 1 Or (m1 = m2 - 1 And r1 < r2

Select Case m1

Case 1 To 6

If m1 = 6 And r1 = 31 Then

Sumation = Sumation + 30

r1 = 30

Else

Sumation = Sumation + 31

End If

m1 = m1 + 1

Case 7 To 11

If m1 = 11 And r1 = 30 And Kabiseh(s1) = 0 Then

Sumation = Sumation + 29

r1 = 29

Else

Sumation = Sumation + 30

End If

m1 = m1 + 1

Case 12

If Kabiseh(s1) = 1 Then

Sumation = Sumation + 30

Else

Sumation = Sumation + 29

End If

s1 = s1 + 1

m1 = 1

End Select

Loop

If m1 = m2 Then

Sumation = Sumation + (r2 - r1)

Else

Select Case m1

Case 1 To 6

Sumation = Sumation + (31 - r1) + r2

Case 7 To 11

Sumation = Sumation + (30 - r1) + r2

Case 12

If Kabiseh(s1) = 1 Then

Sumation = Sumation + (30 - r1) + r2

Else

Sumation = Sumation + (29 - r1) + r2

End If

End Select

End If

If Flag = True Then

Sumation = -Sumation

End If

Diff = Sumation

End Function

در تابع زیر تاریخ شمسی را میگیرد و تعداد روزهایی که باید اضافه شود را به آن اضافه میکند تا تاریخ جدیدی بدست آید ( از تابع MahDays برای استخراج تعداد روزهای هر ماه هم در آن استفاده شده است.) . بدین نحو عمل میکند روی عدد که به add اختصاص میدهید عملیاتی انجام میدهد و آن در لوپی قرار داده میشود یعنی تا زمانیکه add بزرگتراز صفر است این لوپ ادامه می یابد مثلاً اگر add از تعداد روزهای ماه کمتر باشد روز میشود روز + عدد add و عدد را هم برابر صفر قرار میدهیم تا دوباره مورد استفاده قرار نگیرد.

Public Function AddDay(ByVal F_Date As Long, ByVal add As Integer) As Long

Dim K, m, S, R, Days As Integer

R = Rooz(F_Date)

m = mah(F_Date)

S = Sal(F_Date)

K = Kabiseh(S)

Days = MahDays(S, m)

If add > Days - R Then

add = add - (Days - R + 1)

R = 1

If m < 12 Then

m = m + 1

Else

m = 1

S = S + 1

End If

Else

R = R + add

add = 0

End If

While add > 0

K = Kabiseh(s)

Days = MahDays(S, m)

Select Case add

Case Is < Days

R = R + add

add = 0

Case Days To IIf(K = 0, 365, 366) - 1

add = add - Days

If m < 12 Then

m = m + 1

Else

S = S + 1

m = 1

End If

Case Else

S = S + 1

add = add - IIf(K = 0, 365, 366)

End Select

Wend

AddDay = (S * 10000) + (m * 100) + (R)

End Function

مثال ۲۷۹ روزبه تاریخ ۱۶ ۱۲ ۱۳۷۰ اضافه شود 

۱۳۷۰ ۱۲ ۱۶

add=۲۷۹

R=۱۶

m=۱۲

s=۱۳۷۰

K=۱ چون سال ۱۳۷۰ کبیسه است

پاسکاری سال و ماه به تابع MahDays برای استخراج تعداد روز در متغیر Days و چون سال کبیسه است پس ۳۰ روز را بر می گرداند

Days=۳۰

چون add بزرگتر از Addays-R است add میشود و R را یک قرار می دهیم ، چون ماه ۱۲ است عدد m را یک در نظر میگیریم و به عدد سال هم اضافه میکنیم

add=۲۷۹-(۳۰-۱۶+۱)=۲۶۴

R=1

m=1

s=۱۳۷۱

حالا محاسبات تبدیل این ۲۶۴ رابه روزه و ماه باید انجام دهیم بنابراین درون لوپی قرار میگیرد.

K=0 چون سال ۱۳۷۱ کبیسه نیست

Days=MahDays(۱۳۷۱,۱)=۳۱

در لوپ از Select Case استفاده شده دو قسمت کرده  ( برای محاسبه سریعتر ) یکی مواردیکه add کمتر از عدد متغیر days باشد ( یعنی کمتر از عدد ماه ) و دوم مواردیکه add تا رنج خاصی باشد ( To متغیر Case ) 

در add=۲۶۴ از قسمت دوم استفاده شده چون ۲۶۴ در رنج days تا ۳۶۵ یا ۳۶۶ منهای یک قرار میگیرد ،  m را قبلا یک قرار دادیم

m=1

add = add - days

add =۲۶۴ - ۳۱ (ماه ۱ )=۲۳۳

m = m+۱ = ۱ + ۱ =۲

ماه ۲ در تابع MahDays قرار میگیرد

add = add - days

add =۲۳۳ - ۳۱ = ۲۰۲

m = m+۱ = ۱ + ۱ =۲

همینطور کسورات انجام میشود تا عدد add به ۱۸ میرسد و عدد m هم میشود ۸ یعنی آذر ماه در اینجا چون add از عدد ماه ۸ کمتر شده از Case مورد اول استفاده میشود.

R = R + add

R = ۱ + ۱۸ = ۱۹

S = ۱۳۷۱

۱۳۷۱ ۰۸ ۱۹

البته باید ۱۸ بشود چون اختلاف بین دو تاریخ ۱۶ ۱۲ ۱۳۷۰ تا ۱۳۷۱ ۰۸ ۱۸ میشود۲۷۹ روز به باحساب مراجعه شود.

در قسمت CASE ELSE فرضاً اگر عدد add بالاتر از ۳۶۵ یا ۳۶۶ ( منهای یک ) باشد یک عدد به عدد سال اضافه میکند و بعد این اعداد از عدد add کسر میشوند و تا جایی ادامه پیدا میکند که عدد مانده درون یکی از دو کیس قرار گیرد یعنی یا کمتر از عدد ماه مربوطه شود یا بین عدد ماه تا عدد سال باشد و بعد درون مورد اول قرار گیرد.

تابع زیر با توجه به عدد سال و عدد ماه تعداد روزهای آن ماه را بازیابی می کند در تابع جایی نوشته شده  اگر سال کبیسه باشد تعداد روزهای آن ماه را ۳۰ روز تعیین کند

Function MahDays(ByVal Sal As Integer, ByVal mah As Integer) As Integer

Select Case mah

Case 1 To 6

MahDays = 31

Case 7 To 11

MahDays = 30

Case 12

If Kabiseh(Sal) = 1 Then

MahDays = 30

Else

MahDays = 29

End If

End Select

End Function

Function SubtractDay(ByVal F_Date As Long, ByVal Subtract As Long) As Long

Dim K, m, S, R, Days As Integer

R = Rooz(F_Date)

m = mah(F_Date)

S = Sal(F_Date)

K = Kabiseh(S)

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)

 

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

۲۰ آدر ۱۴۰۳

حقیقتی که به زودی افشا می شود

فراربشاراسد و آزادی زندانیان درست مثل تجاوز طالبان به افغانستان 

تجاوز جنسی گسترده در زندان مخوف صیدنایا

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

طبق گزارش الجزیره، نخستین برخورد انقلابیون با زندان صیدنایا شوکه کننده بوده است. انقلابیون زندانیانی را آزاد کرده اند که به مدت 40 سال در سلول های تنگ و تاریک صیدنایا زندانی بوده اند. «راغید الطاطاری» یکی از این زندانیان است. او خلبان نیروی هوایی سوریه بود که ۴۳سال پیش به علت سرپیچی از دستور بمباران حماه توسط حافظ اسد زندانی شد. او دیروز از زندان صیدنایا آزاد شد.

شبکه الجزیره از جنازه‌های تازه زندانیان کشته شده توسط رژیم اسد در صیدنایا گزارش تهیه کرده و خبرنگارش به نقل از چند شاهد در صحنه می‌گوید این جسدها که همگی بر اثر شکنجه به قتل رسیده‌اند حداکثر مربوط به ۱۰ تا ۱۴ روز قبل از سقوط بشار اسد است.

از چندماه قبل به مسئولین سوری هشدار لازم و گزارش اطلاعاتی داده بودیم

از-چندماه-قبل-به-... ‹ article ‹ news ‹ inn.ir

۸ دقیقه پیش · یکی از درس‌های این مسئله‌ی غفلت است، غفلت از دشمن؛ بله در این حادثه دشمن با سرعت عمل کرد، اما اینها بایستی از قبل از حادثه می‌فهمیدند که این

ببینید | روایت خبرنگار صداوسیما در دمشق از لو دادن اطلاعات اماکن حیاتی ...

فیلم ‹ ... ‹ www.khabaronline.ir

۱۶ ساعت پیش · حسینی، خبرنگار صداوسیما در دمشق گفت: بعضی از فرماندهان بلندپایه بشار اسد اطلاعات دقیقی از اماکن حیاتی ارتش سوریه به رژیم صهیونیستی دادند!

دولت انتقالی سوریه از ۸ کشوری که فعالیت دیپلماتیک خود را در دمشق ...

بین الملل ‹ www.asriran.com

۷ ساعت پیش · دولت انتقالی سوریه امروز پنجشنبه ( ۲۲ آذر ۱۴۰۳ ) از هشت کشور به دلیل بازگشایی سریع مراکز دیپلماتیک خود پس از سرنگونی رژیم بشار اسد تشکر کرد

اولین بیانیه بشار اسد بعد از سقوط: تا عصر روز قبل‌ از سقوط دولت در ...

بین الملل ‹ www.asriran.com

۴ ساعت پیش · اولین بیانیه بشار اسد بعد از سقوط: تا عصر روز قبل‌ از سقوط دولت در دمشق بودم · سوریه پس از سقوط بشار اسد: برنامه برای انحلال گروه‌های مسلح و لغو

independentpersian ✓

Twitter › indypersian

علی خامنه‌ای، رهبر جمهوری اسلامی، روز یکشنبه دوم دی ماه در دیدار با جمعی از مداحان به موضوع حمایت احتمالی آمریکا از اعتراضات در ایران واکنش نشان داد. او گفت: «یک عنصر از مسئولین آمریکایی می‌گوید هر کس که در ایران اغتشاش کند، ما کمکش کنیم. احمق‌ها بوی کباب شنیده‌اند.» جمهوری…

Twitter • ۳ ساعت پیش ( ۲ دیماه ۱۴۰۳ )

اعتبارسنجی تاریخ شمسی

Function CheckValidShamsiDate(Dt) As Boolean 

اگر فرمت بدین شکل باشد و / در فیلد ذخیره شود و سال هم چهار رقمی باشد               0000/00/00

((Y=Val(Mid(Dt,1,4

((M=val(Mid(Dt,6,2

((D=Val(Mid(Dt,9,2

If Y<1 And Y>2500 Then

CheckValidShamsiDate=False

End if

Select Case M 

     Case 1 To 6 

        If D>31 And D<1 Then 

         CheckValidShamsiDate=False

       End if 

      Case 7 To 11

      If D>30 And D<1 Then 

        CheckValidShamsiDate=False

      End if

     Case 12 

     If KabisehShamsi(Y)=True Then

    If D>30 And D<1 Then CheckValidShamsiDate=False  

Else if KabisehShamsi(Y)=False 

    If D>29 Abd D<1 Then CheckValidShamsiDate=False  

        End if

End Select

تابع بالا را میتوان در رویداد Exit تکست باکس نوشت که اگر False شد Cancel برابر True شود. چک کردن سال کبیسه ی شمسی هم مفصل در جای دیگر بحث شده.

اضافه کردن به تاریخ میلادی در اکسس

روش : 

1-جداکردن  ماه ، روز و سال و ذخیره در  Alias ها ی M,D,Y که برای تاریخ میلادی بسیار آسان است 

(Y=Year(Dt

(M=Month(Dt

(D=Day(Dt

و اگر تاریخ ورودی اعتبار نداشته باشد فرضا ماهی که ۲۹ روزه است را سی روزه وارد کنید یا ماه را بیشتراز ۱۲ تایپ کنید یا  فرمت اشتباه باشد خودش ارور را اعلام میکند احتمالا بعنوان Type Mismatch ... از توابع بالا برای ماه شمسی نمی توانید استفاده کنید چونکه روزهای ماه شمسی با میلادی فرق میکند.

۲-لوپ زدن از یک تا تعداد روزی که باید به تاریخ اضافه شود یعنی n  منهای یک 

۳-D=D+1

4-اگر D بزرگتر از تعداد روزهای میلادی شد D برابر یک خواهد شد  ( (البته باید طبق سال کبیسه باشد )  و  M=M+1 

5-اگر Y بزرگتر از ۱۲ شد Y=Y+1 و  M=1  

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

اضافه کردن  474003  روز به ۲۲ مارس ۶۲۲ که برابر روز جمعه اول فروردین سال یک است .

بدست آوردن شمسی : (البته با DateDiff میتوان اختلاف بین ۲۲ مارس ۶۲۲ تا ۳۱ دسامبر ۱۹۱۹ را بدست آورد که همین عدد است)

۱-تعداد روزهای سپری شده از اول ماه شمسی که اینجا یک فروردین سال یک است معادل ۲۲ مارس ۶۲۲ موردنظر که اینجا ۱ است 

۲-تعداد کبیسه های میلادی که ۳۱۴ است 

474,003−(1,298×365)−314+
1

 در معادله ی بالا عدد منفی شده که با ۳۶۵ اگر جمع کنیم عدد ۲۸۵ حاصل میگردد که هدف ماست بعد از کم کردن تعداد ماه های شمسی از عدد تا زمانیکه منفی نشده روز بدست می آید که همان ۹ است و تعداد ماه های کم شده باضافه ی یک هم ماه مذبور 

میشود یعنی ۱۰ ... پس تاریخ ۹ دیماه ۱۲۹۸ خواهد شد

 : بدست آوردن میلادی

اگر عدد کوچکتر مساوی صفر شد با ۳۶۵ جمع میزنیم

474,003−(1,298×365)−314

+81+365=365

اضافه کردن ۴۳۰۸ روز به ۳/۲۱/۲۰۰۶ یا معادل شمسی ۸۵/۱/۱

تعداد کبیسه ی ۲۰۰۶ تا ۲۰۱۷ سه است و برای شمسی تعدا د روز را یک فروردین میگیریم در ۸۵/۱/۱

4,308−(11×365)−3+1=291

میلادی ۲۰۰۶

تعدادکبیسه ی ۲۰۰۶ تا ۲۰۱۷ سه است و روزهای سپری شده ی سال ۲۰۰۶ هم عدد ۸۰ است 

4,308−(11×365)−3+80=370

که یکی به سال اضافه میشود و ماه یک میشود ، روز میلادی هم ۵ خواهدشد

روزهای سپری شده از اول سال شمسی تا تاریخ موردنظر

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

از جمعه ۱/۱/۱  تا دوشنبه ۱۳۹۸/۲/۳۰   میشود ۵۱۰۳۰۳

510303 mod 7 = 3    

اگر مانده ی تقسیم صفرشد یعنی جمعه هست ... ۳ یعنی دوشنبه 

۱۳۷۸/۱۰/۱۱    :  ۵۰۳۲۲۴  

معادل شنبه یک ژانویه ی ۲۰۰۰

503224 mod 7 = 1

یک یعنی شنبه

۱۳۷۹/۱۰/۱۲ : ۵۰۳۵۹۰     

معادل دوشنبه ۱ ژانویه ۲۰۰۱

۵۰۳۵۹۰ mod ۷ = ۳

۳ یعنی دوشنبه

۱۳۵۷/۶/۲۰ : ۴۹۵۴۴۲

معادل  دوشنبه ۱۱ سپتامبر ۱۹۷۸ 

۴۹۵۴۴۲ mod ۷ = ۳

۳ یعنی دوشنبه

۱۲۹۸/۱۰/۱۰ : ۴۷۴۰۰۴

معادل پنج شنبه ۱ ژانویه ۱۹۲۰

۴۷۴۰۰۴ mod ۷ = ۶ 

۶ یعنی پنج شنبه

۱۳۹۸/۱/۱ : ۵۱۰۲۴۳

معادل پنج شنبه ۲۱ مارس ۲۰۱۹

۵۱۰۲۴۳ mod ۷ = ۶ 

۶ یعنی پنج شنبه

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

لینک مانده ی تقسیمhttps://www.omnicalculator.com/math/modulo