شرح كود استدعاء بيانات

[وائل يونس سلامي]

الأساتذة الكرام

كل التحيات والتقدير لكم جميعا

أرجو التكرم بشرح هذا الكوذ - استدعاء بيانات وهو من إعداد أستاذنا الكبير و العزيز " خبور " 

كل التحيات والتقدير له ولكم 

وهذا الكود هو :

 

Sub استدعاء()

On Error Resume Next

If [B4] = "" And [C4] = "" And [E4] = "" Then

MsgBox "يجب اختيار حساب بدلالة رقم الحساب او اسم الحساب او اختار رقم فيد", vbInformation + vbMsgBoxRight, "تنبيه"

Else

[B9:H200].ClearContents

[B6] = "" & [K1]

Application.ScreenUpdating = False

For x = 1 To Sheets.Count

MySheets = Sheets(x).Name

If Sheets(x).Name = "القيود" Then Exit For

For R = 3 To Sheets(MySheets).[A1500].End(xlUp).Row

If (Sheets(MySheets).Cells(R, 4) = [B4] Or Sheets(MySheets).Cells(R, 6) = [C4] Or Sheets(MySheets).Cells(R, 1) = [E4]) And (Sheets(MySheets).Cells(R, 7) >= [G4] And Sheets(MySheets).Cells(R, 7) <= [H4]) Then

With Sheets("القيود").[B200].End(xlUp)

          .Offset(1, 0) = Sheets(MySheets).Cells(R, 1)

          .Offset(1, 1) = Sheets(MySheets).Cells(R, 2)

          .Offset(1, 2) = Sheets(MySheets).Cells(R, 3)

          .Offset(1, 3) = Sheets(MySheets).Cells(R, 4)

          .Offset(1, 4) = Sheets(MySheets).Cells(R, 5)

          .Offset(1, 5) = Sheets(MySheets).Cells(R, 6)

          .Offset(1, 6) = Sheets(MySheets).Cells(R, 7)

        End With

     End If

   Next R

Next x

Application.ScreenUpdating = True

MsgBox "!تم استخراج الكشف المطلوب بنجاح", vbInformation + vbMsgBoxRight, "تم الاستخراج"

[B4:E4].ClearContents

End If

End Sub

 

[ياسر خليل أبو البراء]

كود بلا ملف مرفق زي السلطة من غير طماطم .. مع تحياتي

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

عندي ربع ساعة و انا احضر في السلطة دي ، أطلعها و لا أوضعها في الثلاجة ؟

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

على كل حال الشرح يكون كالتالي

 

Sub استدعاء()
' في حالة الخطأ إستمر
On Error Resume Next
'-----------------------------------
'************************************
'------------------------------------
' اذا كانت الخلية بي4 فارغة  و سي4 فارغة  و أو4 فارغة ، إذا
If [B4] = "" And [C4] = "" And [E4] = "" Then
'-------------------------------------
'*************************************
'------------------------------------
' اخرج مساج بوكس نصه هو التالي
MsgBox "يجب اختيار حساب بدلالة رقم الحساب او اسم الحساب او اختار رقم فيد", vbInformation + vbMsgBoxRight, "تنبيه"
'-----------------------------------
'***********************************
'----------------------------------
' و إلا
Else
'----------------------------------
'***********************************
'----------------------------------
' إمسح النطاق : ـ
[B9:H200].ClearContents
'----------------------------------
'**********************************
'-----------------------------------
' الخلية بي 6 تساوي فراغ مضاف اليه الخلية كا 1 ( مضاف لا تعني علامة + و غنما توضع بجانبها
[B6] = "" & [K1]
'-----------------------------------
'**********************************
'----------------------------------
'امنع اهتزاز الشاشة
Application.ScreenUpdating = False
'----------------------------------
'**********************************
'----------------------------------
'حلقة تكرار تبدأ من 1 الى عدد صفحات العمل
For x = 1 To Sheets.Count
'-----------------------------------
'**********************************
' اسناد الصفحة الحالية الى رقم المتغير إكس
MySheets = Sheets(x).Name
'---------------------------------
'*********************************
'---------------------------------
' إذا كان اسم الصفحة هو : قيود اخرج من الحلقة التكرارية
If Sheets(x).Name = "القيود" Then Exit For
'-----------------------------------
'***********************************
'-----------------------------------
' حلقة اخرى بدايتها الصف الثالث و نهايتها آخر شيئ مكتوب في العمود أ
For R = 3 To Sheets(MySheets).[A1500].End(xlUp).Row
'---------------------------------
'*********************************
'---------------------------------
' اذا كانت الخلية حسب قيمة المتغير آر في العمود الرابع تساوي الخلية بي 4 ( نفس الشيئ بالنسبة لبقية السطر مع بعض التغييرات  ) ـ
If (Sheets(MySheets).Cells(R, 4) = [B4] Or Sheets(MySheets).Cells(R, 6) = [C4] Or Sheets(MySheets).Cells(R, 1) = [E4]) And (Sheets(MySheets).Cells(R, 7) >= [G4] And Sheets(MySheets).Cells(R, 7) <= [H4]) Then
'--------------------------------
'**********************************
'---------------------------------
' انظر الى آخر خلية فارغة في العمود بي من ورقة القيود
With Sheets("القيود").[B200].End(xlUp)
 '-------------------------------
 '********************************
'---------------------------------
' امشي بصف واحد من أخر خلية في العمود بي وأكتب فيها ما هو موجود في الخلية مصدر البحث الموجودة في العمود الاول الصف  آر
          .Offset(1, 0) = Sheets(MySheets).Cells(R, 1)
' بقية الاسطر نفس الشي باختلاف الموقع فقط
'---------------------------------
'*********************************
'---------------------------------
'انتهى اسناد الصفحة
        End With
'----------------------------------
'*********************************
'--------------------------------
'انتهى الشرط
     End If
'---------------------------------
'*********************************
'---------------------------------
' اكمل ححتى آخر عدد
   Next R
'--------------------------------
'*********************************
'---------------------------------
Next x
'-----------------------------------
'************************************
'------------------------------------
' ارجع الشاشة لحالتها الاصلية
Application.ScreenUpdating = True
'---------------------------------
'*********************************
'----------------------------------
'اظهر مساج بوكس ينص على التالي
MsgBox "!تم استخراج الكشف المطلوب بنجاح", vbInformation + vbMsgBoxRight, "تم الاستخراج"
'--------------------------------
'*********************************
'---------------------------------
' امسح النطاق التالي
[B4:E4].ClearContents
'**********************************
'----------------------------------
'انتهى الشرط الثاني
End If

 

تم تعديل أبريل 19, 2016 بواسطه أخوكم في الله

[وائل يونس سلامي]

الأساتذة الكرام 

كل الشكر والتقدير لكما و عذرا لأنو السلطة كانت ناقصة البندورة 

شكرا استاذ ياسر على مرورك الكريم 

وشكرا أخينا في الله على شرحك العظيم 

وأدعوكما على حفلة سلطة بس هالمرة مع بندورة ولعيونكم

شكرا مجددا  

[أم روان المصرية]

الان, ياسر خليل أبو البراء said:

كود بلا ملف مرفق زي السلطة من غير طماطم .. مع تحياتي

هههههههههههه

ولو أنى ماليش فى الاكسيل

أحببت أن أقول انتم أحلى منتدى

يجمع بين التعاون والجدية والفكاهة

[ياسر خليل أبو البراء]

شرفنا مرورك العطر بالموضوع أختي الكريمة أم روان ..

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

وإن شاء الله نستفيد من خبراتك

[وائل يونس سلامي]

الأخت أم روان الله يسعد مساكي 

شرفتينا بمرورك 

بس زي ماتكوني سمعتي حد بيتكلم على حاجة مش شغلتو فحبيتي تتدخلي عشان الرجالة ميعرفوش يعملو طبق السلطة كويس 

ودا بءا حايز خبرات حضرتك 

أرجو إني مكنش تأيل دم 

انتي نورت يا أختنا 

 

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

مرحبا

الظاهر إني مثل الأعمى في الزفة ، حصلت حجات من ورايا و انا ميش داري

على العموم اعتذر عن التأخر في الرد لانشغالي بتحضير فورم لاحد الاخوة في المنتدى به الكثير من الميزات استغرق منى أكثر من 10 ساعات عمل و والله انني اقول الصدق و جزيل الشكر لـكم جميعا :

الأخ وائل

والأخ ياسر

الأخت أم روان

 

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

شرح وافى ومتقن وفى ومنتهى الجمال

بارك الله فيك

تقبل تحياتى

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

السلام عليكم

انعمت مساءا أخي إبراهيم

سعدت بمروركم العطر

جزاكم الله خيرا

تقبل تحياتي

[ياسر العربى]

الله ينور اخي في الله  شرح جميل وموفق باذن الله

جزاك الله كل خير

تقبل تحياتي

 

[وائل يونس سلامي]

أخينا في الله  السلام عليكم ورحمة الله و بركاته

الله يزيدك علم و نور يا معلم 

بعد ما قرأت الشرح  - انت مش لازم تتعزم على طبق سلطة انت لازم تتعزم على مشاوي و كباب و سمك مشوي وفتوش و تبولة و ..........  وكم كود VBA  تشرحلنا اياهن بهالسهرة الحلوة 

الله ينور عليك 

ممنون دقنك أنا ( بالسوري ) يعني كتير بتشكرك 

و ما بنسى أبدا فضل الأخوة الحبايب   .... الأخ الحبيب الأستاذ ياسر و كل من يساهم في المساعدة 

بارك الله بكم جميعا

 

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

السلام عليكم

أخي ياسر العربي

جزاكم الله خيرا على المرور و انعم عليكم بالصحة و الهناء

سعدت كثيرا حينما رأيت بصمتكم هنا

أخي وائل يونس

ياراجل . . . . إنت بس إضمنلي أكلة وحدة من القائمة المنسدلة للاطعمة التي ذكرتها  و رمشة عين تلاقيني في مطار دمشق ( في  الطيارة طوالي ) و يا عيني على المشوي و ما جاوره

و راح اطبق عليها الكود التالي :  IF المشوي و الكباب في سوريا then  راح اطير إليها طوالي Else ارجع لبيتي مكسور الخاطر End if

أخي وائل : و الله لقد سعت كثيرا لمرحك و طيبة قلبك ، جزاكم الله خيرا

[وائل يونس سلامي]

الأخ ( أخوكم في الله ) الحبيب تحياتي 

وكل الشكر والامتنان للمساعدة والظرافة واللطافة والله يديم عليك العلم و الصحه و العافة 

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

انت بس نوي تجي عسوريا و المشاوي بتكون ناطرتك عباب المطار 

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

و لعلمك الدعوة مفتوحة 

كان ودي اكتبلك الدعوه بالـ VBA  بس المشكلة لساتني مستجد فيها

تحياتي وشكري