نقل قول: نفر بعدي كيه ؟
ساعت 9:20 بامداد
نكته ويژوال :
به دست اوردن تاریخ شمسی از تاریخ میلادی
به نظر من بهترینشه تو کد مشابه چون من خیلی دنبالش بودم و با همه مقایسش کردم
که همشون تو 2 تا چیز میلنگیدن
1 - سال های کبیثه
2 - سال های بعد از سال کبیثه
ولی این تست شده است
کلی زحمت کشیدم باسش
بهتره شما به عنوان مدول ذخیرش کنین
Dim m1 As Integer, m2 As Integer, m3 As Integer, m4 As Integer, m5 As Integer, m6 As Integer, m7 As Integer, m8 As Integer, m9 As Integer, m10 As Integer, m11 As Integer, m12 As Integer
Dim mon As Integer, kabises As Double
Dim days As Double, ndays As Double
Dim yr, yy, kb
Dim kbs As Boolean, kabise As Boolean
Dim ysd As Double, msd As Double, dsd As Double
Dim Fm(1 To 12) As Integer
Dim Em(1 To 12) As Integer
Private Function MiladiDays2(YYYY, MM, DD) As Double
On Error GoTo erh
MiladiDays2 = 0
ysd = YYYY
msd = MM
dsd = DD
kabises = Int(Val(ysd) / 4)
If Val(ysd) - Int(Val(ysd)) = 0 Then
kabise = True
m2 = 29
Else
kabise = False
m2 = 28
End If
m1 = 31
m3 = 31
m4 = 30
m5 = 31
m6 = 30
m7 = 31
m8 = 31
m9 = 30
m10 = 31
m11 = 30
m12 = 31
Select Case msd
Case 1
mon = 0
Case 2
mon = m1
Case 3
mon = m1 + m2
Case 4
mon = m1 + m2 + m3
Case 5
mon = m1 + m2 + m3 + m4
Case 6
mon = m1 + m2 + m3 + m4 + m5
Case 7
mon = m1 + m2 + m3 + m4 + m5 + m6
Case 8
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7
Case 9
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8
Case 10
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8 + m9
Case 11
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8 + m9 + m10
Case 12
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8 + m9 + m10 + m11
End Select
MiladiDays2 = (Val(ysd) * 365) + Val(kabises) + Val(mon) + Val(dsd)
Exit Function
erh:
MiladiDays2 = "-1"
End Function
Public Function ShamsiDays(YYYY, MM, DD) As Double
sysd = YYYY
smsd = MM
sdsd = DD
skabises = Val(sysd) \ 4
If Val(sysd) + 1 Mod 4 = 0 Then
skabises = Val(skabises) + 1
skabise = True
Else
skabise = False
End If
sm1 = 31
sm2 = 31
sm3 = 31
sm4 = 31
sm5 = 31
sm6 = 31
sm7 = 30
sm8 = 30
sm9 = 30
sm10 = 30
sm11 = 30
Select Case smsd
Case 1
smon = 0
Case 2
smon = sm1
Case 3
smon = sm1 + sm2
Case 4
smon = sm1 + sm2 + sm3
Case 5
smon = sm1 + sm2 + sm3 + sm4
Case 6
smon = sm1 + sm2 + sm3 + sm4 + sm5
Case 7
smon = sm1 + sm2 + sm3 + sm4 + sm5 + sm6
Case 8
smon = sm1 + sm2 + sm3 + sm4 + sm5 + sm6 + sm7
Case 9
smon = sm1 + sm2 + sm3 + sm4 + sm5 + sm6 + sm7 + sm8
Case 10
smon = sm1 + sm2 + sm3 + sm4 + sm5 + sm6 + sm7 + sm8 + sm9
Case 11
smon = sm1 + sm2 + sm3 + sm4 + sm5 + sm6 + sm7 + sm8 + sm9 + sm10
Case 12
smon = sm1 + sm2 + sm3 + sm4 + sm5 + sm6 + sm7 + sm8 + sm9 + sm10 + sm11
End Select
ShamsiDays = (Val(sysd) * 365) + Val(skabises) + Val(smon) + Val(sdsd) - 365
Exit Function
erh:
ShamsiDays = "-1"
End Function
Public Function Miladi2Shamsi(YYYY, MM, DD) As String
yy = 0
ndays = 0
mmMmm = 0
Fm(1) = 31
Fm(2) = 31
Fm(3) = 31
Fm(4) = 31
Fm(5) = 31
Fm(6) = 31
Fm(7) = 30
Fm(8) = 30
Fm(9) = 30
Fm(10) = 30
Fm(11) = 30
Fm(12) = 29
days = MiladiDays2(YYYY, MM, DD)
ndays = days - 226899
yy = Int((ndays - 1) / 365.25)
ndays = Int(Val(ndays) - (yy * 365.25))
For ssss = 1 To 11
If Val(ndays) > Fm(ssss) Then
mmMmm = Val(mmMmm) + 1
ndays = Val(ndays) - Fm(ssss)
End If
Next ssss
mmMmm = Val(mmMmm) + 1
If Val(yy) Mod 4 = 0 Then
If Val(ndays) = 1 And Val(mmMmm) = 1 Then
Miladi2Shamsi = Val(yy) - 1 & "/" & "12" & "/" & "30"
ElseIf Val(ndays) = 1 And Val(mmMmm) <> 1 Then
Miladi2Shamsi = Val(yy) & "/" & Val(mmMmm) & "/" & Fm(Val(mmMmm) - 1)
ElseIf Val(ndays) > 1 Then
Miladi2Shamsi = Val(yy) & "/" & Val(mmMmm) & "/" & Val(ndays) - 1
End If
End If
If Val(yy) Mod 4 <> 0 Then
Miladi2Shamsi = yy & "/" & mmMmm & "/" & ndays
End If
End Function
Public Function Shamsi2Miladi(YYYY, MM, DD) As String
days = ShamsiDays(YYYY, MM, DD)
ndays = days + 226899
sal = YYYY + 622
Do
If sal * 365 + (sal \ 4) > ndays Then
sal = sal - 1
Else
Exit Do
End If
Loop
sal = sal + 1
ndays = ndays - ((sal - 1) * 365 + (sal \ 4))
If sal Mod 4 = 0 Then
kbs = True
mn(2) = 29
Else
kbs = False
mn(2) = 28
End If
mn(1) = 31
mn(3) = 31
mn(4) = 30
mn(5) = 31
mn(6) = 30
mn(7) = 31
mn(8) = 31
mn(9) = 30
mn(10) = 31
mn(11) = 30
mn(12) = 31
'makus kam kon > az mn(12) ba ghabli hash fe aghab bar gard
Shamsi2Miladi = sal & " " & ndays
End Function
Public Function MiladiDays(YYYY, MM, DD) As Double
On Error GoTo erh
MiladiDays = 0
ysd = YYYY
msd = MM
dsd = DD
kabises = Int(Val(ysd) / 4)
If Val(ysd) - Int(Val(ysd)) = 0 Then
kabise = True
m2 = 29
Else
kabise = False
m2 = 28
End If
m1 = 31
m3 = 31
m4 = 30
m5 = 31
m6 = 30
m7 = 31
m8 = 31
m9 = 30
m10 = 31
m11 = 30
m12 = 31
Select Case msd
Case 1
mon = 0
Case 2
mon = m1
Case 3
mon = m1 + m2
Case 4
mon = m1 + m2 + m3
Case 5
mon = m1 + m2 + m3 + m4
Case 6
mon = m1 + m2 + m3 + m4 + m5
Case 7
mon = m1 + m2 + m3 + m4 + m5 + m6
Case 8
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7
Case 9
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8
Case 10
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8 + m9
Case 11
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8 + m9 + m10
Case 12
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8 + m9 + m10 + m11
End Select
MiladiDays = (Val(ysd) * 365) + Val(kabises) + Val(mon) + Val(dsd) - 365
Exit Function
erh:
MiladiDays = "-1"
End Function
برای به دست اوردن تاریخ روز هم باید از کد زیر استفده کنید
مثال:
MsgBox Miladi2Shamsi(Year(Date), Month(Date), Day(Date))
نفر بعدي 2 نفر بعد از نفر قبلیه... نوبتش رو رعایت کنه...
پاسخ با نقل قول
