ماژول تبدیل تاریخ به هجری شمسی
سلام
امروز میخوام یه فداکاری براتون بکنم
میخواه مبدل تاریخ میلادی به هجری شمسی رو براتون بگذارم
این یه ماژوله که میتونید تو هر برنامه که میسازین ازش استفاده کنین در ضمن این ماژول تاریخ رو تست میکنه یعنی اگه اشتباه وارد کرده باشین مثلا 87/521 که در این مثال / وارد نشده که پیغام خطا صادر میکنه در ضمن اگر تاریخ رو مختصر بنویسید اون رو تبدیل به تاریخ کامل میکنه مثال: 1/5/87 --------> 01/05/1387 تشکر یادتون نره
-------------------------------------
کد:
Global Msg(9) As String
Global MonthName(11) As String
Global WeekdayName(6) As String
Global ToDayDateN As String
Global ToDayDate As String
Global Path As String
Sub SetNumber(InText As String, SortText As String)
Dim T1 As String
Dim T2 As String
Dim T3 As String
If Trim(Str(Val(Trim(InText)))) = Trim(InText) Then
If Len(InText) < 5 Then
TextNumber = "ÇÔÊÈÇå"
Else
TextNumber = InText
SortNumber = InText
End If
Else
If Len(InText) < 6 Then
TextNumber = "ÇÔÊÈÇå"
Else
T2 = Trim(Str(Val(Trim(InText))))
If Len(T2) = 2 Then
T1 = Mid(InText, 3, 1)
T3 = Mid(InText, 4, 3)
ElseIf Len(T2) = 3 Then
T1 = Mid(InText, 4, 1)
T3 = T2
T2 = Mid(InText, 5, 2)
End If
If Trim(Str(Val(T2))) <> Trim(T2) Or Trim(Str(Val(T3))) <> Trim(T3) Then
TextNumber = "ÇÔÊÈÇå"
Else
TextNumber = T3 & T1 & T2
SortNumber = T1 & T2 & T3
End If
End If
End If
InText = TextNumber
SortText = SortNumber
End Sub
Function CheckDate(InData As String) As String
i1 = InStr(InData, "/")
i2 = InStr(i1 + 1, InData, "/")
If Val(InData) < 77 Or Val(Mid$(InData, i1 + 1)) > 12 Or Val(Mid$(InData, i1 + 1)) < 1 Or Val(Mid$(InData, i2 + 1)) > 31 Or Val(Mid$(InData, i2 + 1)) < 1 Then
CheckDate = "ÇÔÊÈÇå"
Else
CheckDate = Trim(Str((1300 + Val(InData) Mod 100))) + "/" + Right$("00" + Trim(Str$(Val(Mid$(InData, i1 + 1, 2)))), 2) + "/" + Right$("00" + Trim(Str$(Val(Mid$(InData, i2 + 1, 2)))), 2)
End If
End Function
Public Sub DateF(YerF As Integer, MontF As Integer, DayF As Integer, WeekDayF As Integer)
EYear = Year(Date)
EMonth = Month(Date)
EDay = Day(Date)
WeekDayF = Weekday(Date, vbSaturday) - 1
If EYear Mod 4 = 0 Then Kdat = 1: Kdat3 = 1
If (EYear - 1) Mod 4 = 0 And (EMonth * 100 + EDay) < 321 Then Kdat = 1: Kdat2 = 1: Kdat3 = 0
Roozf = 0
For i = 1 To EMonth - 1
Select Case i
Case 1, 3, 5, 7, 8, 10, 12: Rang = 31
Case 2: Rang = 28 + Kdat3
Case 4, 6, 9, 11: Rang = 30
End Select
Roozf = Roozf + Rang
Next i
Roozf = Roozf + EDay
Roozf = Roozf - 79
If Roozf <= 0 Then Roozf = Roozf + 365 + Kdat2
If Roozf < 187 Then
MonthDays = 31
DayF = Roozf - ((Roozf \ 31) * 31)
Ldat = 1
If DayF = 0 Then DayF = 31: Ldat = 0
MontF = Roozf \ 31 + Ldat
End If
If Roozf > 186 Then
Roozf = Roozf - 6
DayF = Roozf - ((Roozf \ 30) * 30)
Ldat = 1
If DayF = 0 Then DayF = 30: Ldat = 0
MontF = Roozf \ 30 + Ldat
If MontF < 12 Then MonthDays = 30 Else MonthDays = 29 + Kdat2
End If
If (EMonth * 100 + EDay) > 320 - Kdat Then gdat = 621 Else gdat = 622
If DayF = 30 And MontF = 12 Then gdat = 22
YerF = EYear - gdat
End Sub
