ابو حمادة

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

ارجو تطبيق الكود علي الفورم حيث ان خبرتي لا تكفي ولك جزيل الشكر تعديل كود.rar

دا ملف مرفق لو امكن تطبيق الكود الصحيح عليه تعديل كود.rar

Private Sub OptionButton1_Click() With Me If .CheckBox1.Value And .CheckBox2.Value And .CheckBox3.Value = False Then MsgBox "ÇÎÊÇÑ ãÇÈíä ÇáÞíãÉ ÇáäÞÏíÉ Çæ äÓÈÉ ãÆæíÉ" If .CheckBox1.Value And .CheckBox2.Value And .CheckBox3.Value = True Then Sheets("Aldata").Select Range("U2").Select ActiveCell.FormulaR1C1 = "ÇáÕäÝ" If OptionButton1.Value = True Then OptionButton2.Value = False OptionButton3.Value = False OptionButton4.Value = False OptionButton5.Value = False OptionButton6.Value = False 'OptionButton7.Value = False 'OptionButton8.Value = False On Error Resume Next Dim data As Range Dim group1 As Collection Set group1 = New Collection For Each data In add.Range("F6:F" & add.Cells(Rows.Count, "F").End(xlUp).Row) group1.add data, data.Text Next data With Me.ComboBox1 .Clear For i = 1 To group1.Count If group1(i) <> "" Then .AddItem group1(i) End If Next i End With End If Else End Sub يوجد خطأ علي ماعتقد في ترتيب الشروط المطلوب اجبار المستخدم علي اختيار امر من 3 اوامر CheckBox1 او CheckBox2 او CheckBox3 وجزاكم الله خيرا

اخي الفاضل استاذ الصـقر شكرا وتقديرا ليك بجد علي مجهودك الرائع ليا طلب لو امكن اتمنى مكونش بتقل عليك محتاج بعض التعديلات علي الكود هي 1- اضافة عدد 2 عمود في صفحة ( add) وايضا في صفحة ( aldata ) لاستخراج دائن او مدين العمود الاول لمعرفة انه دائن او مدين العمود الاخر لوضع قيمة الدئن او قيمة المدين 2- الخلايه الملونه باللون الاخضر بها قوائم منسدلة اريد اضافة في كل قائمة كلمة ( الكل ) بالاضافة لكلمة ( دائن ) وكلمة ( مدين ) وادراج كود البحث عن دائن او مدين او البحث عن الكل عمود ( المسلسل ) في صفحة ( aldata ) يكون عد تسلسلي وليس يتم نقل بيانات به ولك مني تحياتي ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

اخي الفاضل استاذ الصـقر شكرا وتقديرا ليك بجد علي مجهودك الرائع ليا طلب لو امكن اتمنى مكونش بتقل عليك محتاج بعض التعديلات علي الكود هي 1- اضافة عدد 2 عمود في صفحة ( add) وايضا في صفحة ( aldata ) لاستخراج دائن او مدين العمود الاول لمعرفة انه دائن او مدين العمود الاخر لوضع قيمة الدئن او قيمة المدين 2- الخلايه الملونه باللون الاخضر بها قوائم منسدلة اريد اضافة في كل قائمة كلمة ( الكل ) بالاضافة لكلمة ( دائن ) وكلمة ( مدين ) وادراج كود البحث عن دائن او مدين او البحث عن الكل عمود ( المسلسل ) في صفحة ( aldata ) يكون عد تسلسلي وليس يتم نقل بيانات به ولك مني تحياتي

استاذي الغالي بحار الاكسس اتمني لما تخلص لو امكن يعني تعرفني هنا عشان افتح الاميل بتاعي

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

بالنسبة للاميل basmtaml252@yahoo.com بس فيه ملحوظه مهمه محتاج فيها تخصصات معينه يعني يكون ليها باص ورد لاكتر من يوزر بعض اليوزارات مش يكون ليها كل الصلاحيات

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

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

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

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

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

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

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

اتمني استاذ صقر لو الملف وصل عرفني باي رد

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

السلام عليكم ورحمة الله وبركاته الاخوة الافاضل اتمنى حد يرد علي الاقل السلام يوجد كود نزلته من هذا المنتدى وعايز اطبقه عندى مش عارف افهمة اتمنى حد يشرحه ليا وجزاكم الله خيرا الكـــــــــود On Error GoTo 1 Dim LastR As Long Dim SText As String Dim StDate As Date Dim EndDate As Date Dim LastR1 As Long Application.ScreenUpdating = False Sheets("Aldata1").Range("b6:s10000").ClearContents SText = Sheets("Aldata1").Range("U3") StDate = Sheets("Aldata1").Range("W2") EndDate = Sheets("Aldata1").Range("W3") LastR1 = Sheets("add").Cells(Rows.Count, 2).End(xlUp).Row If SText <> "" Then Sheets("add").Range("b5:s" & LastR1).AutoFilter Field:=3, Criteria1:=SText Sheets("add").Range("b5:s" & LastR1).AutoFilter Field:=1, Criteria1:=">=" & Format(StDate, "yyyy/MM/dd"), Operator:=xlAnd, _ Criteria2:="<=" & Format(EndDate, "yyyy/MM/dd") LastR = Sheets("add").Cells(Rows.Count, 2).End(xlUp).Row If LastR >= 6 Then ' Sheets("add").Range("B5:S" & LastR).SpecialCells(xlCellTypeVisible).Copy Sheets("Aldata1").Range("B6").PasteSpecial Sheets("Aldata1").Range("A6").Select Sheets("add").Range("b5:S4").AutoFilter End If Else If SText = "" Then Sheets("card").Range("b3:k" & LastR1).AutoFilter Field:=1, Criteria1:=">=" & Format(StDate, "yyyy/MM/dd"), Operator:=xlAnd, _ Criteria2:="<=" & Format(EndDate, "yyyy/MM/dd") LastR = Sheets("card").Cells(Rows.Count, 2).End(xlUp).Row If LastR >= 4 Then Sheets("card").Range("C4:k" & LastR).SpecialCells(xlCellTypeVisible).Copy Sheets("كشف الحساب").Range("C7").PasteSpecial Sheets("كشف الحساب").Range("A7").Select Sheets("card").Range("b3:k3").AutoFilter End If End If End If Application.ScreenUpdating = True 1 End Sub

السلام عليكم ورحمة الله وبركاته الاخوة الافاضل اتمنى حد يرد علي الاقل السلام يوجد كود نزلته من هذا المنتدى وعايز اطبقه عندى مش عارف افهمة اتمنى حد يشرحه ليا وجزاكم الله خيرا الكـــــــــود On Error GoTo 1 Dim LastR As Long Dim SText As String Dim StDate As Date Dim EndDate As Date Dim LastR1 As Long Application.ScreenUpdating = False Sheets("Aldata1").Range("b6:s10000").ClearContents SText = Sheets("Aldata1").Range("U3") StDate = Sheets("Aldata1").Range("W2") EndDate = Sheets("Aldata1").Range("W3") LastR1 = Sheets("add").Cells(Rows.Count, 2).End(xlUp).Row If SText <> "" Then Sheets("add").Range("b5:s" & LastR1).AutoFilter Field:=3, Criteria1:=SText Sheets("add").Range("b5:s" & LastR1).AutoFilter Field:=1, Criteria1:=">=" & Format(StDate, "yyyy/MM/dd"), Operator:=xlAnd, _ Criteria2:="<=" & Format(EndDate, "yyyy/MM/dd") LastR = Sheets("add").Cells(Rows.Count, 2).End(xlUp).Row If LastR >= 6 Then ' Sheets("add").Range("B5:S" & LastR).SpecialCells(xlCellTypeVisible).Copy Sheets("Aldata1").Range("B6").PasteSpecial Sheets("Aldata1").Range("A6").Select Sheets("add").Range("b5:S4").AutoFilter End If Else If SText = "" Then Sheets("card").Range("b3:k" & LastR1).AutoFilter Field:=1, Criteria1:=">=" & Format(StDate, "yyyy/MM/dd"), Operator:=xlAnd, _ Criteria2:="<=" & Format(EndDate, "yyyy/MM/dd") LastR = Sheets("card").Cells(Rows.Count, 2).End(xlUp).Row If LastR >= 4 Then Sheets("card").Range("C4:k" & LastR).SpecialCells(xlCellTypeVisible).Copy Sheets("كشف الحساب").Range("C7").PasteSpecial Sheets("كشف الحساب").Range("A7").Select Sheets("card").Range("b3:k3").AutoFilter End If End If End If Application.ScreenUpdating = True 1 End Sub

ممكن حد يعرفني شرح للكود دا عايز اضيف نطاق مختلف من حيث عدد الاعمدة في شيت استدعاء البيانات 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

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

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

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

عبدالله فاروق ابو ريان بصراحه موضوع مميز جدا وكود مختصر وجميل بس هل ينفع ان يستخدم هذا الكود في استدعاء البيانات في مده معينه يعني مثلا استدعاء البيانات في نطاق تاريخين من 1-1-2016 الي 31-4-2-16