نجوم المشاركات

السلام عليكم كل كلام ووجهات نظر اخوتي اعلاه صحيح وجهة نظري ان جميع الجداول في اكسس يجب ان ان يكون لها ترقيم تلقائي وحبذا يكون هو المفتاح ولا ضير ان يتم الحذف وايضا من غير المهم الاستفادة من الارقام المحذوفة ( يمكن وضع آلية بنسخ السجلات المحذوفة وحفظها) هذا العمود هو ملك اكسس وهو المرجع للسجل بما يسمى الــــ (id) ومفيد جدا عند تحويل الجداول الى sql

وعليكم السلام -اهلا بك فى المنتدى -تم عمل واضافة قائمة منسدلة فى عمود المادة من صفحة الوصل بما تحتويه كل أسماء المواد من الصفحة الأخرى ويمكنك اضافة مواد كما تريد بصفحة سعر وصل1.xlsm

اهلا بك فى المنتدى وذلك بإستخدام هذه المعادلة =SUMIFS(INDIRECT("'"&F$1&"'!$F:$F"),INDIRECT("'"&F$1&"'!$D:$D"),$D2,INDIRECT("'"&F$1&"'!$E:$E"),$E2) نموذج1.xlsx

أ.Ali Sadiq جزاك الله خير .. فعلا ملاحظة قيمة أرجو من صاحب الموضوع أن يأخذها بمحمل الجد

وعليكم السلام 🙂 انا طريقتي تختلف عن طريقة اخي الوزير 🙂 الشرح بعد قليل ان شاء الله 🙂 رجاء جرب واخبرنا النتيجة 🙂 انا لم استعمل كود Details_Print ، ولكني غيرت اسمه الى Details_Print2 وتركت هناك ، فقد تحتاج اليه لسبب ما ، فانا لا اعرف جميع امور التقرير 🙂 جعفر 1135.1.Consumable Material Check List (40).accdb.zip

أ.mohamed elalfy هل هذا المطلوب بالتوفيق New Microsoft Access Database2.zip

اهلا بك فى المنتدى شرفتنا,شرح هذه الدالة كالتالى: وهى دالة معرفة وهذا هو الكود المرافق للدالة لحسن عملها Function VLOOKON(ParamArray My_Arg()) As Variant Dim Max As Integer Dim Index As Integer Dim FindOK As Boolean Dim MyFind As String Dim CIndex As Integer MyFind = My_Arg(0) CIndex = My_Arg(1) Max = UBound(My_Arg) FindOK = False For Index = 2 To Max If FindOK Then Exit For VLOOKON = My_Arg(Index).Name R = Range(VLOOKON).Rows.Count C = Range(VLOOKON).Columns.Count If CIndex > C Then VLOOKON = "#REF!": Exit Function For MyR = 1 To R If LCase(Range(VLOOKON)(MyR, 1)) = LCase(MyFind) Then VLOOKON = Range(VLOOKON)(MyR, CIndex) Exit Function End If Next MyR Next Index VLOOKON = "#N/A" End Function وهذا ملف ايضا به مثال يبين تطبيق الدالة لحسن استخدامها VLOOKON With No Limitation.xls

وعليكم السلام -يمكنك استخدام هذه المعادلة لجعل نطاق القائمة المنسدلة مطاطية وبدون فراغات وتكون جاهزة لزيادة اى بيانات جديدة =OFFSET($D$6,,,COUNTIF($D:$D,"?*"),1) كما انه يمكن ايضا استخدام هذه المعادلة لتسمية نطاق لإستخدامه فى الكمبوبوكس كما ترى بالصور تعبئة القوائم 1المنسدلة.xlsm

تعديل بسيط على الكود وضع سطر اضافي بين علامات الـــ +++++ Option Explicit Dim ARR() Dim D As Worksheet, P As Worksheet, I# Sub Data_VAL() Dim K%: K = 1 Set D = Sheets("data"): Set P = Sheets("pv") For I = 1 To D.Cells(Rows.Count, 1).End(3).Row If D.Range("A" & I).Interior.Color = RGB(220, 230, 241) Then ReDim Preserve ARR(1 To K) ARR(K) = D.Range("A" & I).Value K = K + 1 End If Next With P.Range("H5").Validation .Delete .Add 3, , , Join(ARR, ",") End With End Sub '++++++++++++++++++++++++++++++++++++++++++++ Sub get_data() Dim First_Ro%, Laste_ro% Dim Copy_RG As Range Dim clas Dim m%: m = 11 Dim col: col = 2 Set D = Sheets("data"): Set P = Sheets("pv") P.Range("A11:C500").ClearContents P.Range("I11:K500").ClearContents clas = P.Range("H5").Value First_Ro = D.Range("A:D").Find(clas, after:=D.Cells(1000, 1), LOOKAT:=1).Row + 4 Laste_ro = D.Range("A" & First_Ro).End(4).Row Set Copy_RG = D.Range(Cells(First_Ro, 2), Cells(Laste_ro, 3)) For I = 1 To Copy_RG.Rows.Count '++++++++++++++++++++++++++++++ If I > P.Range("H6") Then Exit Sub '+++++++++++++++++++++++++++++++ If m = 36 Then m = 11: col = 10 With P.Cells(m, col - 1) .Value = I .Offset(, 1) = Copy_RG.Cells(I, 1) .Offset(, 2) = Copy_RG.Cells(I, 2) End With m = m + 1 Next End Sub الملف من جدبد med_SALIM_new.xlsm

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

دقق في الكلام اعلاه ,, ما فيه شي اسمه اعطاها يجب ان يكون الترقيم تلقائي يتم بعد نقر زر الحفظ

السلام عليكم استاذ @essam rabea تحية لشخصك الكريم عندي مداخلة هنا بخصوص ملف الاخ السائل الجداول فيه اخطاء كثيرة منها على سبيل المثال كود الصنف نوعه عملة؟ بالنسبة للحل الذي تقدمت به فهو صحيح ميه ميه ولكن احببت ان الفت نظر الاح السائل ليس الا. وهذه الصور من الجداول. تقبل تحياتي

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

وعليكم السلام-جرب هذه الفيديوهات https://www.youtube.com/watch?v=EN18dfR2mhw https://www.youtube.com/watch?v=BIkzEM3i-tA وكمان هذا الرابط من داخل المنتدى جعل ملف الأكسل مشترك على اكثر من جهاز

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

وعليكم السلام ورحمة الله وبركاته توجد اكثر من طريقة لعمل ترقيم والاستغناء عن الترقيم التلقائي الموجود في اكسيس وجدت لك مثالاً يمكنك الاستفادة منه باذن الله 2007-2013.rar تحياتي

الحل في عملية ( ضغط قاعدة البيانات وإصلاحها)

جرب المرفق yoynis2.accdb

بارك اللخ فيك استاذ مجدى وزادك الله من فضله

السلام عليكم ,كان عليك قبل رفع هذه المشاركة استخدام خاصية البحث فى المنتدى فهناك العديد من الموضوعات التى تخص طلبك ومنها :- كيفية إظهار اسم المستخدم على تكست بوكس بعد الدخول برنامج صلاحيات المستخدمين الاصدار 3 شاشة دخول مع صلاحيات

السلام عليكم حدد المدى اخي مايحتاج تحط مسمى لكل ورقة For Each ws In ThisWorkbook.Worksheets If ws.Name = Me.ComboBox3.Value Then With ws .Select Me.ComboBox1.RowSource = .Range("A6:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Address '"name1" ' A Me.ComboBox2.RowSource = .Range("B6:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).Address '"data1" ' B End With End If Next

?

تمام شكرا لحضراتكم تم الاخد في الاعتبار والتعديل

شوف نتائج التقرير في الاسفل ، وبعدين نرجع نضبط اللي في الاعلى.

استاذي Ali Mohamed Ali اكرمك الله وجزاك خيرا وزادك علما

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

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

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

جرب هذا الكود Option Explicit Dim ARR() Dim D As Worksheet, P As Worksheet, I# Sub Data_VAL() Dim K%: K = 1 Set D = Sheets("data"): Set P = Sheets("pv") For I = 1 To D.Cells(Rows.Count, 1).End(3).Row If D.Range("A" & I).Interior.Color = RGB(220, 230, 241) Then ReDim Preserve ARR(1 To K) ARR(K) = D.Range("A" & I).Value K = K + 1 End If Next With P.Range("H5").Validation .Delete .Add 3, , , Join(ARR, ",") End With End Sub '++++++++++++++++++++++++++++++++++++++++++++ Sub get_data() Dim First_Ro%, Laste_ro% Dim Copy_RG As Range Dim clas Dim m%: m = 11 Dim col: col = 2 Set D = Sheets("data"): Set P = Sheets("pv") P.Range("A11:C500").ClearContents P.Range("I11:K500").ClearContents clas = P.Range("H5").Value First_Ro = D.Range("A:D").Find(clas, after:=D.Cells(1000, 1), LOOKAT:=1).Row + 4 Laste_ro = D.Range("A" & First_Ro).End(4).Row Set Copy_RG = D.Range(Cells(First_Ro, 2), Cells(Laste_ro, 3)) For I = 1 To Copy_RG.Rows.Count If m = 36 Then m = 11: col = 10 With P.Cells(m, col - 1) .Value = I .Offset(, 1) = Copy_RG.Cells(I, 1) .Offset(, 2) = Copy_RG.Cells(I, 2) End With m = m + 1 Next End Sub الملف مرفق med_SALIM.xlsm

إليك يا من كان له قدم السبق في ركب العلم والتعليم، إليك يا من بذلت ولم تنتظر العطاء، إليك أهدي عبارات الشكر والتقدير....شكرا للمنتدى الرئع وللعاملين والمشرفين...جزاكم الله الف خير وبميزان حسناتكم...

وعليكم السلام 🙂 اختي ، هذا الموضوع فيه طلبك ، رجاء قراءة الموضوع والكود بالتفصيل : جعفر

السلام عليكم كليك يمين على الخلايا المعنية ثم تنسيق الخلايا

جرب هذا الماكرو Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) With Me.UsedRange .Columns.AutoFit .Rows.AutoFit End With End Sub

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

نعم استاذ عصام الآن يعمل الكود بشكل سليم .. تحية لك على هذا المجهود الرائع بارك الله فيك

أخى ابا جودى محاولة أخرى بعد فكرة أستاذنا AlwaZeeR .. دا لو كنت فهمت .. الجزء العلوى منها مرتبط بإكسيل .. أما بخصوص دا صعب عليا حيث أن فى طريقة أخى أبو الكرم لا يوجد ربط بين التقريرين ولا أدرى إن كان التقرير العلوى سيأخذ بياناته من نفس الجدول أم من جدول آخر وإن كان من جدول آخر فهل يوجد ربط بينهما ولا كل واحد سارح فى كيمياءاته لا تنسى تغيير مسار Source Doc لجدول الإكسيل بما يناسبك Consumable MaterialTest.rar

بارك الله فيك وزادك الله من فضله

اتعرف ما يزيد العمل جمالا اخي العزيز جعفر وجودك هو ما يزين أي مشاركة في هذا الصرح الرائع تحياتي لشخصك الكريم

هذا ماكرو اخر يعتمد على المصفوفات (يجب ان يكون اسرع بكثير خاصة اذا كانت البيانات كثيرة ) لا وجد لاي معادلة Option Explicit Sub get_val_BY_ARRYS() Dim My_Sh As Worksheet Dim ARR, S#, T#, R#, I#, k As Byte Set My_Sh = Sheets("Sheet1") R = My_Sh.Cells(Rows.Count, 3).End(3).Row My_Sh.Range("E4").Resize(R - 3, 4).ClearContents For I = 4 To R With My_Sh.Range("D" & I) If Not IsNumeric(.Value) Then GoTo next_i Select Case .Value Case Is < 100: ARR = Array(.Value, "", "") Case Is < 200: ARR = Array(100, .Value - 100, "") Case Is > 200: ARR = Array(100, 100, .Value - 200) End Select .Offset(, 1).Resize(, 3).Value = ARR For k = LBound(ARR) To UBound(ARR) If IsNumeric(ARR(k)) Then T = ARR(k) * Range("L4").Offset(, k) Else T = 0 End If: S = S + T Next .Offset(, 4) = S: S = 0 End With next_i: Next End Sub

بارك الله فيك وزادك الله من فضله

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

بارك الله فيك وزادك الله من فضله

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

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

تفضل لك ما طلبت بريك.xlsx

تفضل قسم الأدارة-01008432266 (1).xlsx

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

انا متشكر لحضرتك بس هو فى مشكلة بسيطة ممكن حل ليها ان امكن الملف انا ضفت الوقت المتاخر بس بينزل مرتين مرة بال - فى الغياب ومرة بالاضافى فى الاضافة فا كدة بياخد الوقت مرتين قسم الأدارة-01008432266 (1).xlsx

تفضل قسم الأدارة-01008432266.xlsx

انا استخدمن هذه الدالة وهى جميلة وفعالة الف شكر للجميع =IF(b2="";"";SUBTOTAL(3;b$2:b2))