اريد كود او معادله لادخال البيانات فى العمود الاول حسب شروط معينة ( عنوان معدل )

[إبراهيم ابوليله]

الاخوه الكرام

ارجو مساعدتى فى الاتى اريد ان اجبر المستخدم على ادخال البيانات فى العمود الاول كما يلى ان تكون اول الكتابه ثلاث حروف(من a الى z) 1 بعد ذلك يجبر على اخال العلامه - 2 بعد ذلك يكون مجبر على دخال سته ارقام لااكثر ولا اقل 3 بعد ذلك يكون مجبر على ادخال العلامه / 4 بعد ذلك يكون مجبر على ادخال ثلاثه ارقام بدا من 1 الى 999 5

Book1.rar

[أبو حنــــين]

السلام عليكم

جرب المرفق أخي

الكتابة بشروط.rar

[جمال عبد السميع]

ماشاء الله أستاذي فكرتها جميلة جدا لأني حاولت أعملها بالمعادلات عن طريق data validation كانت تستوعب شرطان أو ثلاثة وتتناقض في بند ال ( text) إلي هو (a:z)

[عبدالله المجرب]

ما شاء الله تبارك الله

لم تخطر ببالي هذه الفكرة

صار لي يومين احاول مع حدث التغيير في الخلية

زادك الله من علمه اخي ابو حنين

فكرة ممتازة

[إبراهيم ابوليله]

الاخوه الكرام

بارك الله فيكم

ولكن هل يمكن عمل ذلك بدون الحاجه لاستخدام يوزر فورم

كما اننى اريد تخصيص الكتابه فى العمود الاول فقط

بدايه من الخليه a10

[عبدالله المجرب]

ارى ان الفورم يفي بالغرض ويمكن تحقيق طلبك الثاني

[الخالدي]

السلام عليكم ورحمة الله وبركاته

كالعادة كود متميز اخي الفاضل / أبو حنين

وبعد اذن اخي الفاضل / عبدالله المجرب

هنا محاولة لكود اخر في حدث الورقة

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 1 And Target.Row > 9 Then

On Error GoTo 10

If Target = "" Then Exit Sub

If Len(Target) < 12 Then GoTo 10

If Len(Target) > 14 Then GoTo 10

If Asc(Mid(Target, 1, 1)) < 65 Then GoTo 10

If Asc(Mid(Target, 1, 1)) > 90 Then GoTo 10

If Asc(Mid(Target, 2, 1)) < 65 Then GoTo 10

If Asc(Mid(Target, 2, 1)) > 90 Then GoTo 10

If Asc(Mid(Target, 3, 1)) < 65 Then GoTo 10

If Asc(Mid(Target, 3, 1)) > 90 Then GoTo 10

If Mid(Target, 4, 7) * 1 > 0 Then GoTo 10

If Mid(Target, 11, 1) <> "/" Then GoTo 10

If Mid(Target, 12, 3) * 1 < 1 Then GoTo 10

GoTo 20

10

Target = ""

MsgBox "ادخال غير صحيح"

20

End If

في أمان الله

تم تعديل يونيو 14, 2012 بواسطه الخالدي

[أبو ردينة]

ماشاء الله تبارك الله

الإخوة الأحباب

أبو حنين - الخالدي

جزاكما الله خيرا و نفع بعلمكما

[إبراهيم ابوليله]

الاخ الفاضل

الخالدى

لقد حاول تنفيذ الكود لكن يوجد خطأ

الكود موجود بالشيت رقم 4

ارجو النظر الى الملف المرفق

والخطأ دائما يقف على كلمه END IF

Book1.rar

[الخالدي]

السلام عليكم ورحمة الله

اخي ابراهيم في المشاركة السابقة سقط سهوا السطر الاخير من الكود

End Sub

ارجو قبول اعتذاري

مرفق الملف بعد التعديل

في أمان الله

قناع ادخال.rar

تم تعديل يونيو 17, 2012 بواسطه الخالدي

[إبراهيم ابوليله]

الاخ الخالدى

بارك الله فيك

ولكنى ارى انه لابد عند الادخال تكون الحروف كابس لوك

فهل يمكن التغاضى عن ذلك

بحيث عند الكتابه اكون حر سواء بالكتابه كابس لوك ام لا

[إبراهيم ابوليله]

الاخ الفاضل الخالدى

بارك الله فيك

ولكنى حاولت فهم محتويات الكود

ولم استطع فهمه

ارجو منك مساعدتى فى فهم حتويات الكود من خلال الشرح ان امكن

ولك كل الشكر والاحترام

[عبدالله المجرب]

السلام عليكم

ما شاء الله عليك استاذنا الكبير الخالدي

كود مميز

وبعد اذنك هذا تعديل على الكود ليقبل الحروف الصغيرة والكبيرة باللغة الانجليزية

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 1 And Target.Row > 9 Then

On Error GoTo 10

If Target = "" Then Exit Sub

If Len(Target) < 12 Then GoTo 10

If Len(Target) > 14 Then GoTo 10

If Asc(Mid(Target, 1, 1)) < 65 Then GoTo 10

If Asc(Mid(Target, 1, 1)) > 192 Then GoTo 10

If Asc(Mid(Target, 2, 1)) < 65 Then GoTo 10

If Asc(Mid(Target, 2, 1)) > 192 Then GoTo 10

If Asc(Mid(Target, 3, 1)) < 65 Then GoTo 10

If Asc(Mid(Target, 3, 1)) > 192 Then GoTo 10

If Mid(Target, 4, 7) * 1 > 0 Then GoTo 10

If Mid(Target, 11, 1) <> "/" Then GoTo 10

If Mid(Target, 12, 3) * 1 < 1 Then GoTo 10

GoTo 20

10

Target = ""

MsgBox "إدخال غير صحيح"

20

End If

End Sub

[الخالدي]

السلام عليكم ورحمة الله وبركاته

بارك الله فيك استاذنا و معلمنا عبدالله المجرب

قمت بتعديلات في الكود اضافة الى بعض الشرح وكان جاهزا الى ان انقطاع الكهرباء حال دون وضعه في المنتدى

وكود الاستاذ عبدالله يفي بالغرض

لكن لوجود شرح بسيط ارفق الملف فربما يساعد اخي ابراهيم في اجراء تعديلات قد يحتاجها

في أمان الله

قناع ادخال2.rar

[إبراهيم ابوليله]

الاخوه الكرام والافاضل

الاخ الخالدى

الاخ عبد الله

بارك الله فيكم

ومشكورين على الكود الرائع

ولكنى اريد شيئا اخر

اتمنى ان احصل عليه

الا وهو استخراج الرقم الذى يلى العلامه /Book1.rar

[أبو حنــــين]

السلام عليكم

جرب المرفق

1.rar

[إبراهيم ابوليله]

الاخ ابو حنين

بارك الله فيك

ولكنى ماذالت انتظر كود يقوم بعمل ذلك

[إبراهيم ابوليله]

للرفع

[إبراهيم ابوليله]

للرفع

ارجو المساعده

[رجب جاويش]

تفضل أخى

2.rar

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل كريم الخلق والخلق رجب جاويش حفظك الله

ما شاء الله ولاقوة الا با لله بارك الله فيك وبك ونور بصرك وبصيرتك ور ضي عنك وأرضى خلقه عنك.

أبو أنس

[رجب جاويش]

أخى الحبيب / أبو أنس حاجب

جزاك الله كل خير على الدعاء الكريم والكلمات الطيبة

[إبراهيم ابوليله]

الاخ رجب بارك الله فيك

وماذا لو كنت اريدها بدون زر

[أبو حنــــين]

السلام عليكم

هذا كود أخي الحبيب رجب وضعته في الشيت و يعمل تلقائيا

3.rar

[إبراهيم ابوليله]

الاخ ابو حنين بارك الله فيك