تعديل كود استدعاء بيانات

[ابو حمادة]

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

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

مرفق ملف للاطلاع

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

استدعاء بيانات.rar

 

[ابو حمادة]

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

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

[ابو حمادة]

انا شايف ان فيه تحميلات للملف ال رفعته بس مش شايف اي رد حتى اعرف ان فيه حد مهتم بالموضوع ولا لاء

يريت حد يرد

 

[ابو حمادة]

ممكن حد يعرفني شرح للكود دا 

عايز اضيف نطاق مختلف من حيث عدد الاعمدة في شيت استدعاء البيانات

 

 

Sub Macro1()
Dim iNm As String
Dim Lr As Long, i As Long
Dim R As Integer
Dim d1 As Double, d2 As Double
' ========================================================
' äØÇÞ ÇÓÊÏÚÇÁ ÇáÈíÇäÇÊ

iNm = Range("B1").Value ' ÇÓã äæÚ ÇáÈÍË

d1 = Range("B2").Value2 ' ÈÏÇíÉ ÊÇÑíÎ ÇáÝÊÑÉ  ááÈÍË

d2 = Range("B3").Value2 ' äåÇíÉ ÊÇÑíÎ ÇáÝÊÑÉ ááÈÍË
' ========================================================

' ÈÏÇíÉ ÕÝ ÕÝÍÉ ÇáßÔÝ

هنا محتاج تحديد النطاق لاستدعاء البيانات من ( A6:S1000  )

 

Range("D6:K35").ClearContents
''''''''''''''''
Application.ScreenUpdating = False

' ãÕÏÑ ÇáÈíÇäÇÊ

بالنسبة للشيت دا محتاج نقل كل البيانات الموجودة في النطاق

من ( A6:S1000  )

With sheet1
  ' ÚãæÏ ÇáÈÍË
    Lr = .Cells(.Rows.Count, "C").End(xlUp).Row
    ' ÈÏÇíÉ ÕÝ ÇáÈíÇäÇÊ
    For i = 6 To Lr
    ' ßáãÉ ÇáÈÍË æÇáÚãæÏ ÇáÈÍË
        If iNm = CStr(.Cells(i, "C")) Or iNm = CStr(.Cells(i, "D")) Then
        ' ÊÇÑíÎ
            Select Case .Cells(i, "F").Value2
                Case d1 To d2
                R = R + 1
                ' ÚãæÏ ÇáÏÇÆä
                Cells(R + 5, "D").Value = R
                ' ÚãæÏ ÇáÊÇÑíÎ
                Cells(R + 5, "F").Resize(1, 4).Value = .Cells(i, "F").Resize(1, 4).Value
                If iNm = CStr(.Cells(i, "C")) Then
                ' ÇáÌÇäÈ ÇáÏÇÆä
                    Cells(R + 5, "J").Value = .Cells(i, "J").Value
                Else
                ' ÇáãÈáÛ ÇáÏÇÆä
                    Cells(R + 5, "K").Value = .Cells(i, "K").Value
                End If
            End Select
        End If
    Next
End With
Application.ScreenUpdating = True
End Sub

[ابو حمادة]

ياتري ايه سبب ان مافيش حد بيرد عليا نهائيا ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

هو الموضوع صعب تنفيذه ولا عدم وجود وقت عند اساتذة المنتدي الافاضل ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

تم تعديل أبريل 28, 2016 بواسطه ابو حمادة

[ابو حمادة]

نفسي واحد بس يرد ويرمي عليا السلام

انا حاسس انى لوحدي هنا ؟

 

[بحار الاكسس]

السلام   عليكم أستاذ ابو حامد

[ابو حمادة]

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

اخيرا لقيت حد هنا

 

الحمد لله ان فيه ناس موجودة هههههههههه

يبقا الطلب بتاعي صعب تنفيذه تقريبا

 

[بحار الاكسس]

ساحاول 

[ابو حمادة]

ياريت والله محتاج الملف دا ضرورى جدا

كنت عايز اعرف من حضرتك العت علي الملف

؟؟؟؟؟؟؟؟؟؟؟؟

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

 

[بحار الاكسس]

صدقنى حاولت فيه من ساعة اخر مشاركة مع حضرتك

لان انا فى الاصل مبرمج اكسس وخبرتى حوالى 60% فى الاكسل

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

 

[ابو حمادة]

شكرا لاهتمامك استاذي الغالي 

انا عايز اعمل برنامج خاص بمكتبه لبيع الادوات المدرسية

ومعنديش خبره كتيره

 

تم تعديل أبريل 28, 2016 بواسطه ابو حمادة

[بحار الاكسس]

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

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

تم تعديل أبريل 28, 2016 بواسطه بحار الاكسس

[ابو حمادة]

ممكن تسيب اسم المكتبه احدده انا 

ويريت تكون قابله للتعديل 

[بحار الاكسس]

اوكيه ساصمم لحضرتك شاشة تدخل فيها اسم المكتبة

اعطينى الاميل

 

[ابو حمادة]

بالنسبة للاميل

basmtaml252@yahoo.com

بس فيه ملحوظه مهمه

محتاج فيها تخصصات معينه يعني يكون ليها باص ورد لاكتر من يوزر بعض اليوزارات مش يكون ليها كل الصلاحيات

 

[بحار الاكسس]

اوكيه انت هتكون الادمن وتنشاء حسابات اخرى وتحدد الصلاحيات تمام ؟

[ابو حمادة]

تمام

ويريت يكون فيه مكان في شاشه الدخول لوضع صورة ولو امكن يكون اسم المكتبه متحرك

 

[ابو حمادة]

 استاذي الغالي 

بحار الاكسس

اتمني لما تخلص لو امكن يعني تعرفني هنا 

عشان افتح الاميل بتاعي