جلب بيانات موقف السيارات بالضغط على الرسم

[ابراهيم الزهراني]

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

اسعد الله اوقاتكم بكل خير اساتذتي الكرام

حقيقة انا اشكر جميع الاعضاء في هذا المنتدى عامة والفريق الفني القائم عليه خاضه لما تقدموا من فوائد علمية لا يمكن احدا الاستغناء عنها .

فشكرا لله اولا ثم لكم جميعا

موضوعي اليوم الذي اريد ان اطرحه عليكم لجد المساعدة فيها

هو جدول ستجدونه مرفق عبارة عن ارقم لمواقف سيارات واريد عند اضغط على الموقف يظهر لي بيانات صاحب الموقف في جدول في المربع وتكون جميع البيانات محمية ويكون حفظها بصيغة web page ويكون الجدول المرفق عندي استطاعة التعديل عليها متى ما شئية

رفقة الصورة لفهم ما اريد وكذلك ملف RAR

ولكم مني جزيل الشكر ولا حرمكم الله الاجر والثواب

 

111.rar

[سليم حاصبيا]

و من أين يأخذ الجدول معلوماته؟؟؟

[ابراهيم الزهراني]

المعلومات تكون في الصفحة الثانية ماهي مشكلة المهم عندي انه عند الضغظ على الرقم مثل ( 1 ) تظهر معلومات صاحب الرقم يا ستاذي سليم حاصبيا

تم تعديل يناير 14, 2018 بواسطه ابراهيم الزهراني

[سليم حاصبيا]

جرب هذا الملف

ولك حرية ملء الجدول في الورقة 2 يالبيانات المناسبة

تم ازالة دمج الخلايا لحسن عمل الكود

بالنسبة لصيغة web page ليست لدي الخبرة في ذلك

الرفع 111 Salim.rar

[ابراهيم الزهراني]

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

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

كتالي

رقم 1 في الصورة اريد عند ما اضغط عليه يظهر في المربع تحت بيانات صاحب هذا الرقم

وعند الضغط على رقم 2 تظهر لي بيانات شخص ثاني له بياناته الخاصه به وهكذا

والمقصود من ذلك اريد عند الضغط على الرقم في الصورة اعرف بيانات  من هو صحب الرقم الذي خصصتها له

 

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

وضعت لك ملف لتوضيح اكثر

111.rar

تم تعديل يناير 14, 2018 بواسطه ابراهيم الزهراني

[سليم حاصبيا]

5 دقائق مضت, ابراهيم الزهراني said:

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

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

كتالي

رقم 1 في الصورة اريد عند ما اضغط عليه يظهر في المربع تحت بيانات صاحب هذا الرقم

وعند الضغط على رقم 2 تظهر لي بيانات شخص ثاني له بياناته الخاصه به وهكذا

والمقصود من ذلك اريد عند الضغط على الرقم في الصورة اعرف بيانات  من هو صحب الرقم الذي خصصتها له

 

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

و هذا ما يفعله الماكرو

جرب ان تضغط على اي رقم (في الملف الذي ارسلته لك)و ترى النتيجة

البيانات مأخوذة من الورقة 2 (مخفية)

[ابراهيم الزهراني]

5 دقائق مضت, سليم حاصبيا said:

و هذا ما يفعله الماكرو

جرب ان تضغط على اي رقم (في الملف الذي ارسلته لك)و ترى النتيجة

البيانات مأخوذة من الورقة 2 (مخفية)

للاسف لم اجد شيء في الملف الذي ارسلته نهائياً

وعند الضغط على الرقم لم يظهر لي شيء

[بن علية حاجي]

السلام عليكم

تعديل طفيف على الكود في ملف أخي الكريم سليم أرجو أن يفي الغرض المطلوب...

بن علية حاجي

الرفع 111 Salim.rar

[ابراهيم الزهراني]

الله يسعدك اضغط على الارقام التي في الصورة لا يتغير شيء وكذلك اغير الرقم بنفسي لا تتغير البيانات نهائيا وما اداري ماهي الاسباب

ولكن اعطني الطريقة كيف اربط بين البيانات بحيث اذا  ضغط على واحد من الجدول ياتي بالبيانات كامله من المرفق في الصفحة الثانية وعند كتابة رقم 2 تاتي البيانات الخاصه برقم 2 من الجدول في الصفحة الثانية حتى اختصر عليك الوقت ولا اتعبك معي استاذي

[سليم حاصبيا]

2 ساعات مضت, ابراهيم الزهراني said:

الله يسعدك اضغط على الارقام التي في الصورة لا يتغير شيء وكذلك اغير الرقم بنفسي لا تتغير البيانات نهائيا وما اداري ماهي الاسباب

ولكن اعطني الطريقة كيف اربط بين البيانات بحيث اذا  ضغط على واحد من الجدول ياتي بالبيانات كامله من المرفق في الصفحة الثانية وعند كتابة رقم 2 تاتي البيانات الخاصه برقم 2 من الجدول في الصفحة الثانية حتى اختصر عليك الوقت ولا اتعبك معي استاذي

اي اصدار من اكسل تستعمل

شاهد هذا الفيديو

https://www.youtube.com/watch?v=vtTa8y6i_rM

 

[ابراهيم الزهراني]

2 ساعات مضت, سليم حاصبيا said:

اي اصدار من اكسل تستعمل

شاهد هذا الفيديو

https://www.youtube.com/watch?v=vtTa8y6i_rM

 

الاصدار رقم 2010

وهذه صورتين وضعتها من اجل فهم ما اريد

تم تعديل يناير 14, 2018 بواسطه ابراهيم الزهراني

[بن علية حاجي]

السلام عليكم

البيانات عندك تبدأ من السطر 2 (حسب ما أرى في الصورة) بينما البيانات التي قدمها أخي سليم تبدأ من السطر 7 ولتصحيح هذا الخطأ قم بتغيير الأمرين التاليين في الكود:

Set Mon_range = Sheets("ورقة2").Range("A7:A500")

x = Application.Match(my_Num, Mon_range, 0) + 6

بالأمرين التاليين على الترتيب:

Set Mon_range = Sheets("ورقة2").Range("A:A")

x = Application.Match(my_Num, Mon_range, 0) 

إن شاء الله سيزول المشكل...

بن علية حاجي

تم تعديل يناير 14, 2018 بواسطه بن علية حاجي

[ابراهيم الزهراني]

5 ساعات مضت, سليم حاصبيا said:

و هذا ما يفعله الماكرو

جرب ان تضغط على اي رقم (في الملف الذي ارسلته لك)و ترى النتيجة

البيانات مأخوذة من الورقة 2 (مخفية)

من الرقم 156 الى الرقم 187

والرقم 242

والرقم 228 الى الرقم 232

عند الضغط عليها لا تجلب البيانات مثل الارقام الاخرى ياليت تعدلها لي وكذلك الصفحة الثانية تجعلها تبدأ من رقم A1

ولو تكرمت يا استاذي الفاضل تشرحها لي ما قمت به  لأنني لم اجد صيغة مناسبة للبحث في اليوتيوب لتعلم .

تم تعديل يناير 14, 2018 بواسطه ابراهيم الزهراني

[بن علية حاجي]

السلام عليكم

تم التصحيح في الملف المرفق... 

بن علية حاجي

 

الرفع 111 Salim.rar

[سليم حاصبيا]

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

الكود

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
New_Find_Data
Application.EnableEvents = True
End Sub
'==========================================
Sub New_Find_Data()
On Error Resume Next
Dim i%, True_Fasle As Boolean
Dim Premier_sheet As Worksheet, Second_sheet As Worksheet
Set Premier_sheet = Sheets("ورقة1"): Set Second_sheet = Sheets("ورقة2")
Dim salim_array()
ReDim salim_array(1 To Application.Max(Second_sheet.Range("a:a")))
    For i = 1 To Application.Max(Second_sheet.Range("a:a"))
        salim_array(i) = i
    Next
 True_Fasle = IsError(Application.Match(Selection, salim_array, 0))
If Selection.Cells.Count > 1 Or True_Fasle = True Then GoTo Exit_Me
Dim my_Num%, Mon_range As Range
Dim x%
Set Mon_range = Second_sheet.Range("A2").Resize(UBound(salim_array))
my_Num = Selection.Value
x = Application.Match(my_Num, Mon_range, 0) + 1
 If x > 0 Then
   With Premier_sheet.Cells(26, "k")
        .Value = Second_sheet.Cells(x, 1)
        .Offset(1) = Second_sheet.Cells(x, 1).Offset(, 1)
        .Offset(2) = Second_sheet.Cells(x, 1).Offset(, 2)
        .Offset(3) = Second_sheet.Cells(x, 1).Offset(, 3)
        .Offset(4) = Second_sheet.Cells(x, 1).Offset(, 4)
   End With
   End If
Exit_Me:
   Erase salim_array: Set Mon_range = Nothing
End Sub
'============================================

الملف مرفق

 

Parking Salim.rar

[ابراهيم الزهراني]

للأمانة قليل في حقك كلمة مليون الف شكر فأنت تستأهل اكثر من ذلك على جهودك الجبارة

فأسال الله ان يكتب لك الرزق والسعادة من حيث لا تحتسب وأن يجعل ما تقدم شفيعة لك لا عليك .

 

[سليم حاصبيا]

39 دقائق مضت, ابراهيم الزهراني said:

للأمانة قليل في حقك كلمة مليون الف شكر فأنت تستأهل اكثر من ذلك على جهودك الجبارة

فأسال الله ان يكتب لك الرزق والسعادة من حيث لا تحتسب وأن يجعل ما تقدم شفيعة لك لا عليك .

 

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
New_Find_Data
Application.EnableEvents = True
End Sub
'==========================================
Sub New_Find_Data()
On Error Resume Next
Dim i%, True_Fasle As Boolean
Dim Premier_sheet As Worksheet, Second_sheet As Worksheet
Set Premier_sheet = Sheets("ورقة1"): Set Second_sheet = Sheets("ورقة2")
Dim salim_array(), My_St As Range

ReDim salim_array(1 To Application.Max(Second_sheet.Range("a:a")))

    For i = 1 To Application.Max(Second_sheet.Range("a:a"))
        salim_array(i) = i
    Next
  True_Fasle = IsError(Application.Match(Selection, salim_array, 0))

If Selection.Cells.Count > 1 Or True_Fasle = True Then GoTo Exit_Me
Dim my_Num%, Mon_range As Range, x%

Set Mon_range = Second_sheet.Range("A2").Resize(UBound(salim_array))
my_Num = Selection.Value
x = Application.Match(my_Num, Mon_range, 0) + 1
    If x Then
    
            Set My_St = Second_sheet.Cells(x, 1)
             With Premier_sheet.Cells(26, "k")
                For i = 0 To 4
                     .Offset(i) = My_St.Offset(, i)
                 Next
            End With
            
     End If
Exit_Me:
   Erase salim_array: Set Mon_range = Nothing: Set My_St = Nothing
End Sub
'============================================

 

[ابراهيم الزهراني]

جزيت خيراً

ولكن اود ان اسأل هل من الممكن ان اجعل لها فورم خاص بها محمي

بيحث يكون عندي استطاعة ان ابحث برقم الموقف او رقم لوحة السيارة وعند الكتبة رقم الموقف مثلاً تظهر لي كافة البيانات صاحب الموقف

ويكون فيه خاصية الاضافة والحذف والطباعة الجدول كامل بيانات شخص واحد فقط

 

الاسم

المرتبة

الادارة

القسم

رقم الاتصال

نوع السيارة

رقم لوحة السيارة

 

 

[سليم حاصبيا]

16 دقائق مضت, ابراهيم الزهراني said:

جزيت خيراً

ولكن اود ان اسأل هل من الممكن ان اجعل لها فورم خاص بها محمي

بيحث يكون عندي استطاعة ان ابحث برقم الموقف او رقم لوحة السيارة وعند الكتبة رقم الموقف مثلاً تظهر لي كافة البيانات صاحب الموقف

ويكون فيه خاصية الاضافة والحذف والطباعة الجدول كامل بيانات شخص واحد فقط

 

الاسم

المرتبة

الادارة

القسم

رقم الاتصال

نوع السيارة

رقم لوحة السيارة

 

 

من الضروري رفع مثالاً بسيطاً (حوالي 20 صف) عما تريد بالضبط

[ابراهيم الزهراني]

111.rar

نفس فكرة هذا الاخ

 

تم تعديل يناير 16, 2018 بواسطه ابراهيم الزهراني

[سليم حاصبيا]

جرب هذا الشيء

 

Parking SalimWithUser.rar

[ابراهيم الزهراني]

ممتــــــــــــــــــــــــــــــــــــــــاز جدا

رائع يا استاذي واشكرك من القلب داعي الله ان يوفقك وان يرزقك من اوسع ابواب الرزق

هل من الممكن ان يشتغل الفورم البحث بدون الدخول على الاكسل يعمل كانه برنامج مستقل عن الاكسل .؟

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

[ابراهيم الزهراني]

السلام عليكم

اريد لو تكرمتم تعديل على الملف المرفق وهو عند اختيار رقم الموقف ان يظهر معي اسم السيارة وكذا اضافة امكانية البحث برقم السيارة بالإضافة الى رقم الموقف وتحياتي لكم جميع

ابراهيم.rar

[ابراهيم الزهراني]

انتظر رد الاساتذه الكرام