Printable View
سلام
دوتا مطلب
اول اینکه این ماژول ارزشمند که توسط آقا رسول عزیز تجمیع و منتشر شد، آپدیت نشده و یا دیگر دوستان بروز رسانی برای این ماژول ندادن؟
دوم اینکه اگر بخوام محدوده بین دو تاریخ شمسی رو بدست بیارم که اکثرا برای تهیه گزارش کاربرد داره رو بدست بیارم چطور هست؟ همون دستور Between
سلام از تابع Diff ماژول استفاده كنيد:
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
من هر کاری کردم نشد
میشه این نمونه رو یه بازبینی بکنید؟
سلام
نمونه شما تغيير دادم ببينيد مشكل برطرف شده.
تشکرنقل قول:
نوشته شده توسط amirzazadeh
پس دستور like با دستور between قابل ادغام نیست مستقیما؟
ضمن اینکه بعد از انجام دستورفیلتر سازی، با کلیک بر روی دکمه حذف فیلتر، سابفرم کلا خالی میشه و داده ای رو نشون نمیده!
در مورد بازه زمانی برای ساعت هم به همین نحو نوشته میشه؟
سلام
با دستور like قابل اجرا هست ولي چون يكي از جداول برنامه اپلود نشده بود خطا ميداد.اگه نمونه شامل جداول مرتبط اپلود بشه بهتر ميشه جواب داد.
ممنونم بابت پیگیری
ولی جدول مرتبط با این فرم همین یکی هست که در ضمیمه موجوده
یعنی هم فیلدهای فرم و هم سابفرم به یک جدول مرتبط هست
جدول دومی نیست
سلام !نقل قول:
نوشته شده توسط Mehr@ban
نیازی به استفاده از تابع ماژول تاریخ شمسی نیست ، در همون نمونه اولیه خودت برای فیلتر کردن از از کد های زیر استفاده کن !
Me.frm_sublogs.Form.Filter = "log_EventDate >= '" & txtStartDate & "' and log_EventDate <= '" & txtEndDate & "'"
Me.frm_sublogs.Form.FilterOn = True
Me.frm_sublogs.Requery
ضمناً نام سابفرم را خلاصه تر کن ، من آن را به frm_sublogs تغییر دادم
برای حذف فیلتر هم Me.frm_sublogs.Form.Filter را مساوی "" قرار بده
یا علی
واسه چی همه ضمیمه ها فقط حاوی فرم هستش و جدول نداره پس اطلاعات به چه روشی در جدول ذخیره بشه
خیلی خوب بود واقعا ممنونم
با سلام به همه استادان عزیز من از یک ماژول شمسی در یک برنامه استفاده کردم ولی متاسفانه از اول دسامبر دیگه کار نمی کنه چرا لطفا از دوستان راهنمایی بفرمایید قبلا سپاسگزارم
با سلام به اساتید محترم
من در یک برنامه از ماژول تاریخ شمسی استفاده کردم ولی متاسفانه از اول سپتامبر دیگه جواب نمی ده و با باز کردن برنامه پیغام خطای Run-time error '6':over flow رو میده مشکل کجاست ممنون
لطفا نمونه كارتون رو اپلود كنيد.نقل قول:
نوشته شده توسط hosain937
Option Compare Database
'Çíä ãÊÛííÑ ãÞÏÇÑ ßáíß ÔÏå ÏÑ ÝÑã ÊÞæíã Ñæ ÈÕæÑÊ ÓÑÇÓÑí ÏÑ ÎæÏÔ ÐÎíÑå ãíßäå
Public STRDATE As String
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' Ç' ãÇŽæá ÇÕáÇÍ ÔÏå ÌäÇÈ ÂÒÇÏí ÊæÓØ ÑÓæá ÛáÇãí Èå ÊÇÑíÎ 1390/10/15
' 1- ÊÚÑíÝ ßäíÏ Number(Long) ÇÓÊ ÑÇ ÈÕæÑÊ Date Ç' ÝíáÏåÇíí ßå äæÚ ÂäåÇ
' 2- Çíä ÝíáÏåÇ ÑÇ ÈÕæÑÊ 0000/00/00 ÊäÙíã ßäíÏ InputMask Ç' ÎÇÕíÊ
' Ç' ÈÏáíá 8 ÑÞãí ÏÑ äÙÑ ÑÝÊä ÝíáÏ ÊÇÑíÎ ¡ Çíä ÊæÇÈÚ ÊÇ ÓÇá 9999 ßÇÑÇíí ÏÇÑÏ
' ÊÇÑíÎ ÌÇÑí ÓíÓÊã ÑÇ Èå åÌÑí ÔãÓí ÊÈÏíá ãí ßäÏ Shamsi() Ç' ÊÇÈÚ
' ÈßÇÑ ÈÈÑíÏ Now() ÑÇ ãí ÊæÇäíÏ ÏÑ ÒÇÑÔÇÊ ÈÌÇí ÊÇÈÚ Dat() Ç' ÊÇÈÚ
' Èå ßÇÑ ÈÈÑíÏ / ÑÇ ãíÊæÇäíÏ ÌåÊ ÏÑÌ ÊÇÑíÎ ÏÑ ÌÏÇæá Èå åãÑÇå ShamsiDat() Ç' ÊÇÈÚ
' Ç' ÈÑÇí ÌáæíÑí ÇÒ æÑæÏ ÊÇÑíÎ ÛáØ Èå ÏÑæä íß ÝíáÏ ÈÊÑÊíÈ ÒíÑ Úãá ãíßäíÏ
' ÝíáÏ ãæÑÏ äÙÑ ÈßÇÑ ÈÈÑíÏ ValidationRule ÑÇ ÏÑ ÎÇÕíÊ ValidDate([Field Name])=True Ç' ÊÇÈÚ
'/////////////////////////////////////////////////////////////////////////////////////////////
Public Static Function Shamsi() As Long
'Çíä ÊÇÈÚ ÊÇÑíÎ ÌÇÑí ÓíÓÊã ÑÇ Èå ÊÇÑíÎ åÌÑí ÔãÓí ÊÈÏíá ãí ßäÏ
Dim Shamsi_Mabna As Long
Dim Miladi_mabna As Date
Dim Dif As Long
'ÏÑ ÇíäÌÇ 78/10/11 ÈÇ 2000/01/01 ãÚÇÏá ÞÑÇÑÏÇÏå ÔÏå
Shamsi_Mabna = 13781011
Miladi_mabna = #1/1/2000#
Dif = DateDiff("d", Miladi_mabna, Date)
If Dif < 0 Then
MsgBox "ÊÇÑíÎ ÌÇÑí ÓíÓÊã ÔãÇ äÇÏÑÓÊ ÇÓÊ , ÂäÑÇ ÇÕáÇÍ ßäíÏ."
Else
Shamsi = AddDay(Shamsi_Mabna, Dif)
End If
End Function
Public Function dat() As String
' ÈßÇÑ ÈÈÑíÏ Now() ÑÇ ãí ÊæÇäíÏ ÏÑ ÒÇÑÔÇÊ ÈÌÇí ÊÇÈÚ Dat() ÊÇÈÚ
dat = DayWeek(Shamsi) & " - " & Slash(Shamsi)
End Function
Public Function Slash(F_Date As Variant) As String
' Çíä ÊÇÈÚ íß ÊÇÑíÎ ÑÇ ÏÑíÇÝÊ æ ÈÕæÑÊ íß ÑÔÊå 10 ÑÞãí ÔÇãá / æ åÇÑ ÑÞã ÈÑÇí ÓÇá ÈÇÒãíÑÏÇäÏ
F_Date = Replace(F_Date, "/", "")
Dim a As Long
a = CLng(F_Date)
Slash = Format(IL(a), "0000") & "/" & Format(ay(a), "00") & "/" & Format(Guon(a), "00")
End Function
Function ValidDate(F_Date As Variant) As Boolean
' Çíä ÊÇÈÚ ÇÚÊÈÇÑ íß ÚÏÏ æÑæÏí ÑÇ ÇÒ äÙÑ ÊÇÑíÎ åÌÑí ÔãÓí ÈÑÑÓí ãí ßäÏ
' ÑÇ ÈÑãí ÑÏÇäÏ False æÇÑ äÇãÚÊÈÑ ÈÇÔÏ True ÇÑ ÊÇÑíÎ ãÚÊÈÑ ÈÇÔÏ
On Error GoTo Err_ValidDate
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Dim M, s, R As Byte
F_Date = Replace(F_Date, "/", "")
R = Guon(CLng(F_Date))
M = ay(CLng(F_Date))
s = IL(CLng(F_Date))
If F_Date < 10000101 Then Exit Function
If M > 12 Or M = 0 Or R = 0 Then Exit Function
If R > ayDays(s, M) Then Exit Function
ValidDate = True
Exit_ValidDate:
On Error Resume Next
Exit Function
Err_ValidDate:
Select Case err.Number
Case 0
Resume Exit_ValidDate:
Case 94
ValidDate = True
Case Else
MsgBox err.Number & " " & err.Description, vbExclamation, "Error in module Module2 - function ValidDate"
Resume Exit_ValidDate:
End Select
End Function
Public Function AddDay(ByVal F_Date As Variant, ByVal add As Long) As Long
'Çíä ÊÇÈÚ ÊÚÏÇÏ ÑæÒ ÏáÎæÇå ÑÇ Èå ÊÇÑíÎ ÑæÒ ÇÖÇÝå ãíßäÏ
On Error GoTo Err_AddDay
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
F_Date = Replace(F_Date, "/", "")
Dim K, M, R, Days As Byte
Dim s As Integer
R = Guon(CLng(F_Date))
M = ay(CLng(F_Date))
s = IL(CLng(F_Date))
K = Kabiseh(s)
'ÊÈÏíá ÑæÒ Èå ÚÏÏ 1 ÌåÊ ÇÏÇãå ãÍÇÓÈÇÊ æ íÇ ÇÊãÇã ãÍÇÓÈå
Days = ayDays(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) 'ßÈíÓå: 1 æ ÛíÑ ßÈíÓå: 0
Days = ayDays(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 = CLng(s & Format(M, "00") & Format(R, "00"))
Exit_AddDay:
On Error Resume Next
Exit Function
Err_AddDay:
Select Case err.Number
Case 0
Resume Exit_AddDay:
Case 94
AddDay = 0
Case Else
MsgBox err.Number & " " & err.Description, vbExclamation, "Error in module Module2 - function AddDay"
Resume Exit_AddDay:
End Select
End Function
Function SubDay(ByVal F_Date As Variant, ByVal Subtract As Long) As Long
'Èå ÊÚÏÇÏ ÑæÒ ãÚíäí ÇÒ íß ÊÇÑíÎ ßã ßÑÏå æ ÊÇÑíÎ ÍÇÕáå ÑÇ ÇÑÇÆå ãíßäÏ
On Error GoTo Err_SubDay
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
F_Date = Replace(F_Date, "/", "")
Dim K, M, s, R, Days As Byte
R = Guon(CLng(F_Date))
M = ay((CLng(F_Date)))
s = IL((CLng(F_Date)))
K = Kabiseh(s)
'ÊÈÏíá ÑæÒ Èå ÚÏÏ 1 ÌåÊ ÇÏÇãå ãÍÇÓÈÇÊ æ íÇ ÇÊãÇã ãÍÇÓÈå
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) 'ßÈíÓå: 1 æ ÛíÑ ßÈíÓå: 0
Days = ayDays(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
SubDay = (s * 10000) + (M * 100) + (R)
Exit_SubDay:
On Error Resume Next
Exit Function
Err_SubDay:
Select Case err.Number
Case 0
Resume Exit_SubDay:
Case 94
SubDay = 0
Case Else
MsgBox err.Number & " " & err.Description, vbExclamation, "Error in module Module2 - function SubDay"
Resume Exit_SubDay:
End Select
End Function
Public Function DayWeekNo(F_Date As Variant) As Byte
'Çíä ÊÇÈÚ íß ÊÇÑíÎ ÑÇ ÏÑíÇÝÊ ßÑÏå æ ÔãÇÑå ÑæÒ åÝÊå ÑÇ ãÔÎÕ ãí ßäÏ
'ÇÑ ÔäÈå ÈÇÔÏ ÚÏÏ 0
'ÇÑ 1ÔäÈå ÈÇÔÏ ÚÏÏ 1
'......
'ÇÑ ÌãÚå ÈÇÔÏ ÚÏÏ 6
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
F_Date = Replace(F_Date, "/", "")
Dim day As String
Dim Shmsi_Mabna As Long
Dim Dif As Long
'ãÈäÇ 80/10/11
Shmsi_Mabna = 13801011
Dif = Diff(Shmsi_Mabna, CLng(F_Date))
If Shmsi_Mabna > CLng(F_Date) Then
Dif = -Dif
End If
'ÈÇ ÊæÌå Èå Çíäßå 80/10/11 3ÔäÈå ÇÓÊ ãÍÇÓÈå ãíÔæÏ day ãÊÛíÑ
day = (Dif + 3) Mod 7
If day < 0 Then
DayWeekNo = day + 7
Else
DayWeekNo = day
End If
End Function
Public Function DayWeek(F_Date As Variant) As String
'Çíä ÊÇÈÚ íß ÊÇÑíÎ ÑÇ ÏÑíÇÝÊ ßÑÏå æ ãÔÎÕ ãí ßäÏ å ÑæÒí ÇÒ åÝÊå ÇÓÊ
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Dim a As String
Dim n As Byte
n = DayWeekNo(F_Date)
Select Case n
Case 0
a = "ÔäÈå"
Case 1
a = "íß ÔäÈå"
Case 2
a = "Ïæ ÔäÈå"
Case 3
a = "Óå ÔäÈå"
Case 4
a = "åÇÑ ÔäÈå"
Case 5
a = "äÌ ÔäÈå"
Case 6
a = "ÌãÚå"
End Select
DayWeek = a
End Function
Public Function Diff(ByVal date1 As Variant, ByVal Date2 As Variant) As Long
'Çíä ÊÇÈÚ ÊÚÏÇÏ ÑæÒåÇí Èíä Ïæ ÊÇÑíÎ ÑÇ ÇÑÇÆå ãí ßäÏ
On Error GoTo Err_Diff
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
date1 = Replace(date1, "/", "")
Date2 = Replace(Date2, "/", "")
Dim tmp As Long
Dim S1, M1, R1, S2, M2, R2 As Integer
Dim Sumation As Single
Dim Flag As Boolean
Flag = False
If CLng(date1) = 0 Or IsNull(CLng(date1)) = True Or CLng(Date2) = 0 Or IsNull(CLng(Date2)) = True Then
Diff = 0
Exit Function
End If
'ÇÑ ÊÇÑíÎ ÔÑæÚ ÇÒ ÊÇÑíÎ ÇíÇä ÈÒÑÊÑ ÈÇÔÏ ÂäåÇ ãæÞÊÇ ÌÇÈÌÇ ãí ÔæäÏ
If CLng(date1) > CLng(Date2) Then
Flag = True
tmp = CLng(date1)
date1 = CLng(Date2)
Date2 = tmp
End If
R1 = Guon(CLng(date1))
M1 = ay(CLng(date1))
S1 = IL(CLng(date1))
R2 = Guon(CLng(Date2))
M2 = ay(CLng(Date2))
S2 = IL(CLng(Date2))
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
Exit_Diff:
On Error Resume Next
Exit Function
Err_Diff:
Select Case err.Number
Case 0
Resume Exit_Diff:
Case 94
Diff = 0
Case Else
MsgBox err.Number & " " & err.Description, vbExclamation, "Error in module Module2 - function Diff"
Resume Exit_Diff:
End Select
End Function
Function ayName(ByVal ay_no As Byte) As String
'Çíä ÊÇÈÚ íß ÊÇÑíÎ ÑÇ ÏÑíÇÝÊ ßÑÏå æ ãÔÎÕ ãí ßäÏ å ãÇåí ÇÒ ÓÇá ÇÓÊ
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Select Case ay_no
Case 1
ayName = "ÝÑæÑÏíä"
Case 2
ayName = "ÇÑÏíÈåÔÊ"
Case 3
ayName = "ÎÑÏÇÏ"
Case 4
ayName = "撄"
Case 5
ayName = "ãÑÏÇÏ"
Case 6
ayName = "ÔåÑíæÑ"
Case 7
ayName = "ãåÑ"
Case 8
ayName = "ÂÈÇä"
Case 9
ayName = "ÂÐÑ"
Case 10
ayName = "Ïí"
Case 11
ayName = "Èåãä"
Case 12
ayName = "ÇÓÝäÏ"
End Select
End Function
Function ayDays(ByVal IL As Integer, ByVal ay As Byte) As Byte
'Çíä ÊÇÈÚ ÊÚÏÇÏ ÑæÒåÇí íß ãÇå ÑÇ ÈÑãí ÑÏÇäÏ
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Select Case ay
Case 1 To 6
ayDays = 31
Case 7 To 11
ayDays = 30
Case 12
If Kabiseh(IL) = 1 Then
ayDays = 30
Else
ayDays = 29
End If
End Select
End Function
Function Make_Date(ByVal F_Date As Long) As String
'íß ÊÇÑíÎ ÑÇ ÈÕæÑÊ íß ÑÔÊå 10 ÑÞãí ÈÇ ÐßÑ åÇÑ
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>ÑÞ ã ÈÑÇí ÓÇá ÇÑÇÆå ãí ßäÏ
Dim d As String
d = Trim(Str(F_Date))
If IsNull(F_Date) = True Or F_Date = 0 Then
Make_Date = ""
Else
Make_Date = Mid(d, 1, 4) & "/" & Mid(d, 5, 2) & "/" & Mid(d, 7, 2)
End If
End Function
Function ILay(ByVal F_Date As Long) As Long
'ÔÔ ÑÞã Çæá ÊÇÑíÎ ßå ãÚÑÝ ÓÇá æ ãÇå ÇÓÊ ÑÇ ÈÑãí ÑÏÇäÏ
ILay = Val(Left$(F_Date, 6))
End Function
Public Function Guon(F_Date As Long) As Byte
'Çíä ÊÇÈÚ ÚÏÏ ãÑÈæØ Èå ÑæÒ íß ÊÇÑíÎ ÑÇ ÈÑãÑÏÇäÏ
Guon = F_Date Mod 100
End Function
Function ay(F_Date As Long) As Byte
'Çíä ÊÇÈÚ ÚÏÏ ãÑÈæØ Èå ãÇå íß ÊÇÑíÎ ÑÇ ÈÑãÑÏÇäÏ
ay = Int((F_Date Mod 10000) / 100)
End Function
Public Function IL(F_Date As Long) As Integer
'Çíä ÊÇÈÚ ÚÏÏ ãÑÈæØ Èå ÓÇá íß ÊÇÑíÎ ÑÇ ÈÑãÑÏÇäÏ
IL = Int(F_Date / 10000)
End Function
Public Function Kabiseh(ByVal OnlyIL As Variant) As Byte
'æÑæÏí ÊÇÈÚ ÚÏÏ ÏæÑÞãí ÇÓÊ
'Çíä ÊÇÈÚ ßÈíÓå ÈæÏä ÓÇá ÑÇ ÈÑãíÑÏÇäÏ
'ÇÑ ÓÇá ßÈíÓå ÈÇÔÏ ÚÏÏ íß æ ÏÑÛíÑ ÇíäÕæÑÊ ÕÝÑ ÑÇ ÈÑ ãíÑÏÇäÏ
Kabiseh = 0
If OnlyIL >= 1375 Then
If (OnlyIL - 1375) Mod 4 = 0 Then
Kabiseh = 1
Exit Function
End If
ElseIf OnlyIL <= 1370 Then
If (1370 - OnlyIL) Mod 4 = 0 Then
Kabiseh = 1
Exit Function
End If
End If
End Function
Function Nextay(ByVal IL_ay As Long) As Long
If (IL_ay Mod 100) = 12 Then
Nextay = (Int(IL_ay / 100) + 1) * 100 + 1
Else
Nextay = IL_ay + 1
End If
End Function
Function Previousay(ByVal IL_ay As Long) As Long
If (IL_ay Mod 100) = 1 Then
Previousay = (Int(IL_ay / 100) - 1) * 100 + 12
Else
Previousay = IL_ay - 1
End If
End Function
Public Function Firstday(IL As Integer, ay As Integer) As Long
'ÔãÇÑå Çæáíä ÑæÒ ãÇå
Dim strfd As Long
strfd = IL & Format(ay, "00") & Format(1, "00")
Firstday = DayWeekNo(strfd)
End Function
Public Function Guon1(F_Date As Long) As Byte
'Çíä ÊÇÈÚ ãÔÎÕ ãí ˜äÏ ˜å í˜ ÊÇÑíÎ äÏãíä ÑæÒ ÓÇá ÇÓÊ
ILROOZ = ay(Shamsi()) - 1
If ay(Shamsi()) < 6 Then
Guon1 = (F_Date Mod 100) + (ILROOZ * 30) + (ay(Shamsi())) - 1
Else
Guon1 = (F_Date Mod 100) + (ILROOZ * 30) + 6
End If
End Function
سلام
من با access 2016 , windows 10 این ماژولهای شمسی را امتحان کردم، مشکله برام پیش آماده که امیدوارم بتونین کمکم کنین.
وقتی که فرم های نمونه را بررسی میکنم تمامی کدها درست کار میکنند و لی به محض وارد شدن به پنجره build و خروج error به شرح زیر پیغام میدهد.
the expression you entered contains invalid syntax
you may enteredan operandwithout an operator
سلام
دو تا پيشنهاد دارم اميدوارم به دردتون بخوره:
1-اگر ويندوز و افيس شما 32 بيتي هست با كليد G+Ctrl وارد محيط كد نويسي بشيد و يكبار كدهاتون رو كامپايل كنيد اگر كدها مشكلي داشته باشند برنامه متوقف و روي كد مشكل دار متوقف ميشه.
2-اگر ويندوز وافيس 64 بيت هست بايد براي declare متغير ها از ptrsafe استفاده كنيد.
........................
موفق باشيد
باسلام
میشه مورد 2 را بیشتر توضیح بدهید
من این مشکل the expression you entered contains invalid syntax access را در کوئری دارم
DLookUp("lngEmpID"؛"t_login"؛"name='" & DMax("[name]"؛"q_login") & "' ")
یه علامتی تو این کد مشکل داره..البته اولین بار که باز میکنم مشکلی ندارد ، به محضی که می خواهم کد جدیدی در قسمت or اضاقه کنم ، پیام ارور بالا می دهد
قسمت مشکل داره اینه :؛
با سلام
من در اکسل از این دستور استفاده میکنم
که ماه را به صورت تک رقمی میده مثلا 1 و میخواهم داده را به صورت 01 بدهد و نمیخواهم Format cell را تغییر دهم
ay(shamsi)
من از این دستور میکنم
Private Sub Date21_Click()
ActiveCell.Select
ActiveCell = IL(Shamsi()) & "/" & ay(Shamsi()) & "/" & Me.ActiveControl.Caption
Unload Me
End Sub
چون زمانیکه از دستور DayWeek استفاده میکنم نمیتواند ماه را بخواند و سیستم هنگ میکند.
اگر 1398/01/18 دیتا باشد DayWeek کار میکند اما اگر 1398/1/18 باشد DayWeek نمیتواند روز هفته را محاسبه کند
ممنون میشوم من را راهنمایی کنید
سلام . برای قسمت ماه فرمت تعریف کنید.
("00",(()format(ay(Shami
با سلامنقل قول:
نوشته شده توسط mosaArabi
این کار که شما میگیند یعنی فرمت سل را عوض کنم؟؟
درود
این ماژول سال ۱۴۰۰ به بعد رو صحیح نمایش میده؟
سلام اکثر کدها درست کار میکنه
سلام دوستان
میخواستم از اکتیوایکس جناب آقای پیروزمهر در کوئری استفاده کنم تابع مورد نظر IsDateBetween است که باید به یک فانکشن تبدیل بشه کسی میتونه در این مورد کمک کنه که چطوری این تابع را در کوئری استفاده کنم
با سلام و عرض ادب خدمت دوستان گرامی
ببخشین میشه بفرمایین چجوری میشه بازه سال رو تغییر داد؟ واسه من از سال 1381 الی 1430 وجود داره که میخام این بازه به سال 1320 تا 1430 تغییر پیدا کنه.
دوستان مشکلم حل شد ممنوننقل قول:
نوشته شده توسط mahdi545