التعديل علي كود التنقل بين الخلايا

[ماجدجلال]

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

لدي كود صممت للتنقل بين مجموعة من الخلايا بنئا علي رقم الشقة المدخل بواسطة الدالة inputbox

وهذة هو الكود

 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NoRoom As String
If Range("D" & Target.Row).Value > 0 Then
 NoRoom = InputBox("ادخل رقم الشقة المراد ادخل بيانات النزيل فيها")
End If
Select Case NoRoom
Case Is = 151
Range("A4").Select
Case Is = 152
Range("A5").Select
Case Is = 153
Range("A6").Select
Case Is = 154
Range("A7").Select
Case Is = 155
Range("A8").Select
Case Is = 156
Range("A9").Select
Case Is = 157
Range("A10").Select
End Select

End Sub

المطلوب اود اضافة شرط في حالة اذا ادخل المستخدم رقم غير الارقام 151 152 153 154 155 156 157

وتظهر رسالة masbox تخبرة بان هذا الرقم غير موجود في ارقام الشقق

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

واذا كانت هناك طريقة افضل لكتابة الكود السابق ارجو وضعها , فان اغلب هذا الكود تعلمت كتابتة من هنا من هذا المنتدي ونطمع في تعليم المزيد ,

 

وشكرا لكم

[علي السحيب]

وعليكم السلام،

بصراحة عندما طرحت سؤالك لأول مرة .. لم أفهم ما كنت تريده بالضبط .. ولكن عندما رأيت الكود والملف المرفق فهمت طلبك .. وأعتقد أن الكود التالي أقصر ويخدم بشكل أكبر ويعمل على كامل الأعمدة وليس على خلايا معينة فقط .. أي بإمكانك إضافة سجلات آخرى جديدة بدون التعديل على الكود..

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RoomNo As String
Dim fndRoom As Range
If Target.Count = 1 And Target.Column = 4 Then
If Target.Value > 0 Then
RoomNo = InputBox("أدخل رقم الشقة المُراد إدخال بيانات النزيل فيها","نموذج إدخال رقم الشقة")
With Columns(3)
Set fndRoom = .Find(RoomNo)
End With
If Not fndRoom Is Nothing Then
fndRoom.Offset(0, -2).Select
Else
MsgBox "رقم الشقة الذي أدخلته غير موجود", vbExclamation, "عفــواً"
End If
End If
End If
End Sub

حظاً سعيداً،

تم تعديل نوفمبر 10, 2005 بواسطه علي السحيب

[ماجدجلال]

الف شكرا لك استاذ علي

سوف اجرب الكود , والنتيجة مسبقا معروفة

الف شكر

[ماجدجلال]

شكرا لك استاذ علي

الكود نجح بشكل فعال

الف شكرا لك