[حل شده] Data Validation تاریخ در VBA

[a.dal65]

با سلام
خدمت دوستان
در فرم VBA خودم میخوام کاربر فقط بتونه تاریخ رو بصورت xxxx/xx/xx(روز/ماه/سال) وارد کنه

یعنی حتما سال 4 رقمی باشه و ماه و روز 2 رقم باشی

(اگه بصورت 1394/1/11 یا 94/01/11 یا 1394/1/11یا هر جور دیگه وارد کرد خطا بده)
فرمت درست :1394/01/11
این هم فایل
انجمن اکسل ایران

[Amir Ghasemiyan]

سلام دوست عزیز
از این قطعه کد کمک بگیرید

a = Split("1394/11/13", "/")
If Len(a(0)) <> 4 Or Len(a(1)) <> 2 Or Len(a(2)) <> 2 Then MsgBox "error"

برای تکمیل میتونین عدد بودن رو هم چک کنید

If IsNumeric(a(0)) = False Or IsNumeric(a(1)) = False Or IsNumeric(a(2)) = False Then MsgBox "error"

[a.dal65]

ممنون
من اون تاریخ رو برای مثال زدم.
میخوام کاربر هر تاریخی رو بتونه وارد کنه ولی فرمت تاریخ حتما بضورت xxxx/xx/xxباشه .
(توی فایل ، textbox5 "مورخه فیش " میخوام این محدودیت رو داشته باشه)

[Amir Ghasemiyan]

ممنون
من اون تاریخ رو برای مثال زدم.
میخوام کاربر هر تاریخی رو بتونه وارد کنه ولی فرمت تاریخ حتما بضورت xxxx/xx/xxباشه .

منم برای مثال اون تاریخ رو گذاشتم
شما بجای تاریخ یا مقدار سلول رو باید بدین یا مقدار تکست باکس یا هر جایی که ورودی هست

[امين اسماعيلي]

tarkibe code aghaye ghasemian ro ba in code bebin be khastat miresonatet

Private Sub TextBox1_Change()
Dim TextStr As String

        TextStr = TextBox1.Text

        If (Len(TextStr) = 5 And Mid(TextStr, 5, 1) <> "/") Then
            TextStr = Left(TextStr, 4) & "/" & Right(TextStr, 1)
        ElseIf (Len(TextStr) = 8 And Mid(TextStr, 8, 1) <> "/") Then
            TextStr = Left(TextStr, 7) & "/" & Right(TextStr, 1)
        End If

        TextBox1.Text = TextStr
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim TextStr As String

        TextStr = TextBox1.Text
'If Len(TextStr) <> 10 Then
'MsgBox "wrong format"
'TextBox1 = ""
'End If
a = Split(TextStr, "/")
If Len(a(0)) <> 4 Or Len(a(1)) <> 2 Or Len(a(2)) <> 2 Then
MsgBox "error"
TextBox1 = ""
End If
End Sub

[a.dal65]

ممنون از هر دو بزرگوار
فقط اقا امین من دقیقا همون کد شما رو که گذاشتم از این قسمت خطا میگرفت:
If Len(a(0)) <> 4 Or Len(a(1)) <> 2 Or Len(a(2)) <> 2 Then
و کار نکرد
بعد اومد اینجوریش که کردم درست شد :

Private Sub TextBox1_Change()
Dim TextStr As String

        TextStr = TextBox1.Text

        If (Len(TextStr) = 5 And Mid(TextStr, 5, 1) <> "/") Then
            TextStr = Left(TextStr, 4) & "/" & Right(TextStr, 1)
        ElseIf (Len(TextStr) = 8 And Mid(TextStr, 8, 1) <> "/") Then
            TextStr = Left(TextStr, 7) & "/" & Right(TextStr, 1)
        End If

        TextBox1.Text = TextStr
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim TextStr As String

        TextStr = TextBox1.Text
If Len(TextStr) <> 10 Then
MsgBox "wrong format"
TextBox1 = ""
End If
'a = Split(TextStr, "/")
'If Len(a(0)) <> 4 Or Len(a(1)) <> 2 Or Len(a(2)) <> 2 Then
'MsgBox "error"
'TextBox1 = ""
'End If
End Sub

و درست هم کار کرد و مشکلی نداشت.
فقط در یک صورت کار نمیکنه: که کاربر تاریخ رو اشتباه تایپ کنه و بعد به فیلد دیگه ای نره (Event Exit اجرا نشه) و روی دکمه ذخیره کلیک کنه.(در این حالت تاریخ اشتباه ذخیره میشه)
مشکل بالا رو چظور رفع کنم که در هنگام ذخیره هم چک کنه؟

[امين اسماعيلي]

با درود

تو دکمه کلیدت. که مثلا کار ثبت رو انجام میده. همیشه ما اولش میایم برسی هامونو انجام میدیم . مثلا اگر تکست باکسی خالی بود اجرا نشه و ....

در همون کلید چک کن در اول خطوط کد هات که فرمت وارد شده درسته یا نه. اگر نبود exit sub و end if دیگه بقیه کد هات اجرا نمیشن. چون از ساب خارج میشی

[a.dal65]

ممنون
من اینو به اول گزینه ثبت اضافه کردم ولی کار نکرد

Dim a As String
a = Split(TextBox5, "/")
If Len(a(0)) <> 4 Or Len(a(1)) <> 2 Or Len(a(2)) <> 2 Then
MsgBox "error"
Exit Sub
End If

به a گیر میده:

---------------------------
Microsoft Visual Basic for Applications
---------------------------
Compile error:

Expected array
---------------------------
OK Help
---------------------------

[Amir Ghasemiyan]

دوست عزیز چرا اصرار دارین کدها رو با هم ترکیب کنید؟
کدی که من نوشتم خودش کامله نیاز به ترکیب با کدهای دیگه نیست
این کل کدی که شما نیاز دارین برای textbox1

Private Sub TextBox1_Change()
a = Split(TextBox1.Text, "/")
If Len(a(0)) <> 4 Or Len(a(1)) <> 2 Or Len(a(2)) <> 2 Then MsgBox "error"
If IsNumeric(a(0)) = False Or IsNumeric(a(1)) = False Or IsNumeric(a(2)) = False Then MsgBox "error"
End Sub

[a.dal65]

با سلام
آقا امیر ، کد شما رو در فایل گذاشتم ولی باز هم همون ارور قبلی رو گرفت از این قسمت خطا میگیره:
If Len(a(0)) <> 4 Or Len(a(1)) <> 2 Or Len(a(2)) <> 2 Then
یه نگاه بندازید بهش ممنون میشم .(به شیت datauser برید و دکمه ثبت قسط رو بزنید و یه چیزی در تکس باکس 5 بنویسید)


والا من هم اصرار ندارم شلوغش کنم و دوست هم ندارم شلوغ بشه
ولی مجاب به انجام این کار شدم. علتش هم این هست که وقتی کاربر تاریخ رو اشتباه تایپ میکنه اگه به textbox بعدی نره (یعنی exit اجرا نشه ) میتونه تاریخ رو اشتباه ذخیره کنه .
من فقط میخوام خواسته ام محقق بشه
ممنون.

[Amir Ghasemiyan]

بله چک کردم کد من ناقص بود
این کد اصلاح شده خدمت شما

Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
a = Split(TextBox5.Text, "/")
If UBound(a) = 2 Then
If Len(a(0)) <> 4 Or Len(a(1)) <> 2 Or Len(a(2)) <> 2 Then MsgBox "error"
If IsNumeric(a(0)) = False Or IsNumeric(a(1)) = False Or IsNumeric(a(2)) = False Then MsgBox "error"
Else
MsgBox "error"
End If
End Sub

[a.dal65]

ممنون امیر جان درست شد.
حالا چطور توی دکمه ذخیره هم بیارم که اگه تاریخ اشتباه باشه نتونه ذخیره کنه ؟

[Amir Ghasemiyan]

ممنون امیر جان درست شد.
حالا چطور توی دکمه ذخیره هم بیارم که اگه تاریخ اشتباه باشه نتونه ذخیره کنه ؟

خواهش میکنم
میتونین کدهای داخلش رو کپی کنید.
با توجه به اینکه شما میگین میخواین دابل چک بشه من پیشنهاد میکنم بصورت یک فانکشن استفاده کنید. به این صورت:
این فانکشن شما:

Function DateCheck(tarikh As String) As Boolean
DateCheck = True
a = Split(tarikh, "/")
If UBound(a) = 2 Then
    If Len(a(0)) <> 4 Or Len(a(1)) <> 2 Or Len(a(2)) <> 2 Then DateCheck = False
    If IsNumeric(a(0)) = False Or IsNumeric(a(1)) = False Or IsNumeric(a(2)) = False Then DateCheck = False
Else
    DateCheck = False
End If
End Function

هر جا خواستین استفاده کنید مثل این کد عمل کنید. مثلا الان برای تکست باکس 5 مینویسم:

Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If DateCheck(TextBox5.Text) = False Then MsgBox "Error"
End Sub