ماژول عمومي براي پيغام تاريخ شمسي

[abas1388]

سلام
فرض كنيد در فرم فايل نمونه ضميمه چند تكست باكس وجود داشته باشد كه همگي براي وارد كردن تاريخ باشد . چگونه ميتوانيم كدي را كه در رويداد BeforeUpdate تكست باكس فرم نوشته ايم را بصورت يك ماژول عمومي تبديل كنيم كه در تكست باكس هاي ديگر و حتي در فرم هاي ديگر كه داراي تكست باكس تاريخ است از آن استفاده كنيم و مجبور نباشيم كل كدهاي فوق را در رخداد BeforeUpdate هر تكست باكس وارد كنيم .
با تشكر

[aaa_zarea]

دوست عزيز جواب شما در فايل پيوست تقديم مي گردد

[abas1388]

دوست عزيز جواب شما در فايل پيوست تقديم مي گردد
سلام

سه سؤال:
1- در تكست باكس تاريخ اگر input mask بصورت 00/00/0000 باشد و تاريخ را هم درست وارد كنيد همان پيغام اشتباه بودن تاريخ صادر ميشود ولي اگر input mask بصورت ####/##/##;0 ;_ باشد اين پيغام صادر نميشود .
2- اگر input mask بصورت ####/##/##;0 ;_ باشد اختلاف دو تاريخ بدست نمي آيد ولي وقتي input mask بصورت 00/00/0000 باشد اختلاف دو تاريخ بدست ميآيد منتها با صدور پيغام اشتباه بودن تاريخ
3- در تكست باكس تاريخ اگر پيغام اشتباه بودن تاريخ وارده صادره شد چگونه فوكوس برروي همان تكست باكس باقي بماند؟
با تشكر

[alirezabahrami]

سلام

سه سؤال:
1- در تكست باكس تاريخ اگر input mask بصورت 00/00/0000 باشد و تاريخ را هم درست وارد كنيد همان پيغام اشتباه بودن تاريخ صادر ميشود ولي اگر input mask بصورت ####/##/##;0 ;_ باشد اين پيغام صادر نميشود .
2- اگر input mask بصورت ####/##/##;0 ;_ باشد اختلاف دو تاريخ بدست نمي آيد ولي وقتي input mask بصورت 00/00/0000 باشد اختلاف دو تاريخ بدست ميآيد منتها با صدور پيغام اشتباه بودن تاريخ
3- در تكست باكس تاريخ اگر پيغام اشتباه بودن تاريخ وارده صادره شد چگونه فوكوس برروي همان تكست باكس باقي بماند؟
با تشكر
سلام
با input mask بصورت 00/00/0000 عدد 6 را در كد(( m = Val(Mid(MyDate, 6, 2 به 5 تغيير بده!
موفق باشيد

[abas1388]

سلام
با input mask بصورت 00/00/0000 عدد 6 را در كد(( m = Val(Mid(MyDate, 6, 2 به 5 تغيير بده!
موفق باشيد
با سلام وتشكر
جواب فوق براي سؤال اول و دوم درست بود ولي سؤال سوم بي جواب ماند.
با تشكر دوباره

[abas1388]

[

سلام

3- در تكست باكس تاريخ اگر پيغام اشتباه بودن تاريخ وارده صادره شد چگونه فوكوس برروي همان تكست باكس باقي بماند؟
با تشكر
سلام
از اساتيد بزرگوار تقاضا دارم در در خصوص سؤال بالا بنده را راهنمائي فرمايند . براي برنامه ام خيلي به جواب آن نياز دارم .
با تشكر

[مهدی قربانی]

سلام
خط قرمز رنگ رو به کد ماجول Module1 اضافه کنید .

Function FDateValid(MyDate)

Dim d, m, y As Integer
Dim f As Boolean
f = True
If IsNull(MyDate) Then
Exit Function
End If
MyDate = Trim(MyDate)
y = Val(Left(MyDate, 4))
m = Val(Mid(MyDate, 6, 2))
d = Val(Right(MyDate, 2))
'If Not (Y >= 58 And Y <= 68) Then F = False
If Not (m >= 1 And m <= 12) Then f = False
If Not (d >= 1 And d <= 31) Then f = False
If m > 6 And d > 30 Then f = False
If m = 12 And d = 30 Then f = False
If f = False Then
MsgBox "!ÊÇÑíÎ ÇÔÊÈÇå æÇÑÏ ÔÏå ÇÓÊ .áØÝÇ ÊÇÑíÎ ÑÇ ÇÕáÇÍ ßäíÏ", vbExclamation, "ÎØÇ"
'Screen.ActiveForm.Controls(CtrlName).SetFocus
f = False
DoCmd.CancelEvent
End If


End Function
ضمناً برای سفارشی تر کردن ماجول میتونید به روش زیر عمل کنید :


Function FDateValid(MyDate)

Dim d, m, y As Integer
Dim f As Boolean
Dim strMsg As String
f = True
If IsNull(MyDate) Then
Exit Function
End If
MyDate = Trim(MyDate)
y = Val(Left(MyDate, 4))
m = Val(Mid(MyDate, 6, 2))
d = Val(Right(MyDate, 2))
strMsg = ""
'If Not (Y >= 58 And Y <= 68) Then F = False
If Not (m >= 1 And m <= 12) Then
f = False
strMsg = "!ماه اشتباه وارد شده است .لطفا ماه را اصلاح كنيد"
End If
If Not (d >= 1 And d <= 31) Then
f = False
strMsg = "!روز اشتباه وارد شده است .لطفا روز را اصلاح كنيد"
End If
If m > 6 And d > 30 Then
f = False
strMsg = "!تعداد روزهاي هر ماه در شش ماهه دوم سال حداکثر 30 روز است .لطفا روز را اصلاح كنيد"
End If
If Kabiseh(y) = 0 And d = 30 Then
f = False
strMsg = "!تعداد روزهاي اسفند ماه حداکثر 29 روز است .لطفا روز را اصلاح كنيد"
End If

If f = False Then
MsgBox strMsg, vbExclamation, "خطا"

f = False
DoCmd.CancelEvent
End If


End Function

[abas1388]

If m = 12 And d = 30 Then
f = False
strMsg = "!تعداد روزهاي اسفند ماه حداکثر 29 روز است .لطفا روز را اصلاح كنيد"
End If

با سلام خدمت جناب آقای قربانی بزرگوار!
شرط بالا ، برای سال کبیسه که در آن تعداد روزهای اسفند 30 روز است چگونه باید تغییر کند ؟
با تشکر

[مهدی قربانی]

سلام
درسته ، برای حل این موضوع می تونید از تابع Kabiseh ماجول شمسی استفاده کنید ، برای اصلاح این حالت خط مورد نظر رو با خط زیر جایگزین کنید ، ضمناً کدهای پست قبلی هم اصلاح شد .


If Kabiseh(y) = 0 And d = 30 Then

[جعفر88]

سلام
لطفا توابع نمونه زير رو هم امتحان كنيد . اگه ايرادي هم بود ممنون ميشم با پيام بهم اطلاع بدين راستش زياد وقت نكردم دقيق بررسي كنم.(يه اشكال جزئي داشت كه اصلاح شد)

[abas1388]

سلام
اگر input mask تكست باكس تاريخ را بصورت 00/00/0000 وارد كنيم و ارقامي از تاريخ را وارد نكنيم مثلاً فقط عدد سال را وارد بكنيم و بدون وارد كردن عدد ماه و روز كليد اينتر را بزنيم با پيغام تصوير ضميمه مواجه ميشويم . آيا راهي براي عدم صدور پيغام فوق يا تبديل پيغام فوق به فارسي وجود دارد ؟
البته اگر input mask تكست باكس تاريخ را بصورت _;0;##/##/#### وارد نمائيم پيغام فوق صادر نميشود ولي با اين input mask دو تكست باكس تاريخ را نميتوان از همديگر كم كرد .
با تشكر

[جعفر88]

سلام
اگر input mask تكست باكس تاريخ را بصورت 00/00/0000 وارد كنيم و ارقامي از تاريخ را وارد نكنيم مثلاً فقط عدد سال را وارد بكنيم و بدون وارد كردن عدد ماه و روز كليد اينتر را بزنيم با پيغام تصوير ضميمه مواجه ميشويم . آيا راهي براي عدم صدور پيغام فوق يا تبديل پيغام فوق به فارسي وجود دارد ؟
البته اگر input mask تكست باكس تاريخ را بصورت _;0;##/##/#### وارد نمائيم پيغام فوق صادر نميشود ولي با اين input mask دو تكست باكس تاريخ را نميتوان از همديگر كم كرد .
با تشكر
سلام
در اين مورد زياد بحث شده و دوستان اطلاعات مفيدي رو ارائه كردن ولي براي پاسخ مختصر عرض كنم كه براي سفارسي كردن پيام خطاهاي خود اكسس شما ميتونيد كد دلخواهتون را براي رويداد OnError فرم تنظيم كنيد مثلا براي جواب قسمت اول سوالتون كد زير رو در رويداد فوق وارد كنيد :

Private Sub Form_Error(DataErr As Integer, Response As Integer)
If DataErr = 2279 Then
Response = acDataErrContinue
MsgBox "پيام فارسي شما"
End If
End Sub

در مورد ورود داده به كمك InputMask بايد عرض كنم كه دليل وجود اين خاصيت هم براي ورود آسان و دقيق دادهاست ولي براي درخواست دومتون هم مي تونيد سه كادر متني(TextBox) رو در يك كادر برچسب(Label) ادغام و تركيب كنيد و اين طوري ورود ارقام تاريخ براي سال،ماه و روز به طور جداگانه انجام ميشه و در آخر با كدي اونارو در يه textbox مخفي يا يك فيلد ذخيره كنيد .