Public Sub MeToday(ByRef ShDay As Integer, ByRef ShMonth As Integer, ByRef ShYear As Integer, ByRef ShWeekDay As String)
'This procedure change NowDate to Shamsi date and save it in ShDay , ShMonth, ShYear variables.
'Also it return the Persian Weekday in ShWeekDay variable and can use in all parts of project

Dim aryweekday(7) As String
aryweekday(1) = "í˜ÔäÈå"
aryweekday(2) = "ÏæÔäÈå"
aryweekday(3) = "Óå ÔäÈå"
aryweekday(4) = "åÇÑÔäÈå"
aryweekday(5) = "äÌÔäÈå"
aryweekday(6) = "ÌãÚå"
aryweekday(7) = "ÔäÈå"
Dim year1, month1, day1, temp As String
Dim IntDay As Integer
Dim IntMonth As Integer
Dim IntYear As Integer
Dim intShamsDay As Integer
Dim intShamsMonth As Integer
Dim intShamsYear As Integer
Dim intTemp As Integer
Dim intRemain As Integer

IntDay = Day(Date)
IntMonth = Month(Date)
IntYear = Year(Date)

Select Case IntMonth
Case Is = 1:
intShamsYear = IntYear - 622
If IntDay <= 20 Then
intShamsMonth = 10
intShamsDay = IntDay + 10
Else
intShamsMonth = 11
intShamsDay = IntDay - 20
End If

Case Is = 2:
intShamsYear = IntYear - 622
If IntDay <= 19 Then
intShamsMonth = 11
intShamsDay = IntDay + 11
Else
intShamsMonth = 12
intShamsDay = IntDay - 19
End If

Case Is = 3:
If IntDay <= 20 Then
intShamsMonth = 12
intShamsDay = IntDay + 9
intShamsYear = IntYear - 622
Else
intShamsMonth = 1
intShamsDay = IntDay - 20
intShamsYear = IntYear - 621
End If

Case Is = 4:
intShamsYear = IntYear - 621
If IntDay <= 20 Then
intShamsMonth = 1
intShamsDay = IntDay + 11
Else
intShamsMonth = 2
intShamsDay = IntDay - 20
End If

Case Is = 5:
intShamsYear = IntYear - 621
If IntDay <= 21 Then
intShamsMonth = 2
intShamsDay = IntDay + 10
Else
intShamsMonth = 3
intShamsDay = IntDay - 21
End If

Case Is = 6:
intShamsYear = IntYear - 621
If IntDay <= 21 Then
intShamsMonth = 3
intShamsDay = IntDay + 10
Else
intShamsMonth = 4
intShamsDay = IntDay - 21
End If

Case Is = 7:
intShamsYear = IntYear - 621
If IntDay <= 22 Then
intShamsMonth = 4
intShamsDay = IntDay + 9
Else
intShamsMonth = 5
intShamsDay = IntDay - 22
End If

Case Is = 8:
intShamsYear = IntYear - 621
If IntDay <= 22 Then
intShamsMonth = 5
intShamsDay = IntDay + 9
Else
intShamsMonth = 6
intShamsDay = IntDay - 22
End If


Case Is = 9:
intShamsYear = IntYear - 621
If IntDay <= 22 Then
intShamsMonth = 6
intShamsDay = IntDay + 9
Else
intShamsMonth = 7
intShamsDay = IntDay - 22
End If

Case Is = 10:
intShamsYear = IntYear - 621
If IntDay <= 22 Then
intShamsMonth = 7
intShamsDay = IntDay + 8
Else
intShamsMonth = 8
intShamsDay = IntDay - 22
End If

Case Is = 11:
intShamsYear = IntYear - 621
If IntDay <= 21 Then
intShamsMonth = 8
intShamsDay = IntDay + 9
Else
intShamsMonth = 9
intShamsDay = IntDay - 21
End If

Case Is = 12:
intShamsYear = IntYear - 621
If IntDay <= 21 Then
intShamsMonth = 9
intShamsDay = IntDay + 9
Else
intShamsMonth = 10
intShamsDay = IntDay - 21
End If
End Select
year1 = Trim(Str(intShamsYear))
month1 = Trim(Str(intShamsMonth))
day1 = Trim((intShamsDay))
ShYear = year1
ShMonth = month1
ShDay = day1
ShWeekDay = aryweekday(DatePart("w", Date))
End Sub
Public Function CheckDate(ByVal InDay As Long, ByVal InMonth As Long, ByVal InYear As Long) As Boolean
CheckDate = True
If Not (InYear >= 1300 And InYear <= 9999) Then
CheckDate = False
Exit Function
End If
If Not (InDay >= 1 And InDay <= 31) Then
CheckDate = False
Exit Function
End If
If InMonth >= 1 And InMonth <= 12 Then
If InMonth >= 1 And InMonth <= 6 And InDay > 31 Then
CheckDate = False
Exit Function
End If

If InMonth >= 7 And InMonth <= 12 And InDay > 30 Then
CheckDate = False
Exit Function
End If
Else
CheckDate = False
Exit Function
End If
End Function