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

اسماء الحقول اصبحت C1 و C2 و C3 ، واعمل خلفيتهم باللون الذي تحب ، وعند حدث بعد التحديث ، سيتم اختيار المربع الذي يحمل نفي الرقم ، بنفس لون الخلفية: استعمل هذا الكود : Private Sub Select_it(ctl As Control) For i = 1 To 32 If Me("[" & i & "]") = Me(ctl.Name) Then Me("[" & i & "]").BackColor = Me(ctl.Name).BackColor End If Next i End Sub Private Sub C1_AfterUpdate() Call Select_it(C1) End Sub Private Sub C2_AfterUpdate() Call Select_it(C2) End Sub Private Sub C3_AfterUpdate() Call Select_it(C3) End Sub . جعفر 1402.1.Random Numbers.accdb.zip

الآن فهمت انك تحتاج توليد الرقم داخل نطاق الرقمين اتفضل التعديل توليد رقم عشوائي.accdb

وهذه مشاركة مع اخي واستاذي العزيز استاذ جعفر بطريقة التنسيق الشرطي qqq.rar

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

نعم كان عبارة عن سؤال باستخدام اسلوب الاستفهام التعجبي وهو من الاساليب السبعة للاستفهام و من ذلك قوله تعالى " ما لهذا الرسول يأكل الطعام ويمشي في الأسواق " وقوله تعالى " كَيْفَ تَكْفُرُونَ بِاللَّهِ وَكُنتُمْ أَمْوَاتاً فَأَحْيَاكُمْ " وفي هذا النوع من الاستفهام لا يتطلب وضع العلامة " ؟ "

شكرا جزيلا اخوي حسام انك نبهتنا لخطأ التكرار ، واللي صعب معرفته غير انك تجعل الارقام من 1 الى 32 🙂 هذا تعديل الكود حقي : Private Sub cmd_Generate_Random_Click() Dim i As Integer Dim j As Integer Dim f As Integer Dim e As Integer Dim t As Single t = Timer 'احفظ سجل النموذج If Me.Dirty Then Me.Dirty = False f = Me.[f-no] e = Me.[e-no] For i = 1 To 32: Me("[" & i & "]") = 0: Next i For i = 1 To 32 Try_Again: Dim MyValue Randomize Timer MyValue = Int((e * Rnd) + f) '1. No Duplicates For j = 1 To i If Val(Me("[" & j & "]")) = MyValue Then GoTo Try_Again Next j '2 Smaller than, Or Greater than If MyValue < f Or MyValue > e Then GoTo Try_Again Else Me("[" & i & "]") = MyValue End If Next i Debug.Print Timer - t End Sub . وتلاحظ اني حسبت الوقت اللي الكود يأخذه في عمل اللازم ، ويمكن مقارنة سرعة الكود هذا مع كود اخوي حسين واخوي حسام 🙂 جعفر

السلام عليكم 🙂 الظاهر انك تتب طريقة خاصة في عمل فاتورة جديدة ، او انك وضعت الكود في حدث آخر !! لأن الكود الذي اعطيتك هو عينا نفس الكود الذي اعطاك الاخ خالد ، والاثنين يعطون تقرير برقم الفاتورة الموجودة في النموذج او النموذج الفرعي !! على العموم ، هذه صورة عن مكان الكود الذي وضعته انا : . وهذا تعديل بسيط لحفظ السجل قبل طباعة التقرير: Dim stDocName As String If Me.Dirty Then Me.Dirty = False stDocName = "re3" 'DoCmd.OpenReport stDocName, acNormal, , "[invo]=" & Me.invo DoCmd.OpenReport stDocName, acViewPreview, , "[invo]=" & Me.invo جعفر

جرب الامر Dim stDocName As String stDocName = "re3" DoCmd.OpenReport stDocName, acNormal, , "[invo]=" & Me.Parent!id الملف مرفق برنامجي.mdb

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

اشكرك اخي محمد وبارك فيك ولك في هذا اليوم العظيم .. نعم هذا ماريده وجزاك الله خير

نعم هناك فرق من ناحية اسلوب الإدخال و التعامل دعنا نتحدث بالأمثلة طلما ان تريد معرفة الإسلوب في البداية كلغة استعلام SQL فلن يتغيير بها شي هي نفسها سواء استخدمت الطرق التي ذكرتها ففي الخيار الأول سوف تقوم من ناحية اضافة البيانات الى الجدول بكتابة الكود بالطريقة التالية DoCmd.RunSQL "INSERT INTO table_name " & _ "(column1, column2,...)" & _ "VALUES (value1, value2,....)" هذا الإسلوب في الإدخال مجهد نوعا ما لأن مضطر لجعل القيم بجانب بعضها و عند الرغبة في التعديل سوف تجد نفسك مضطر لقرآة العبارة كاملة او ان تكون نظرة اكثرة دقة هذه مثلها مثل هذه العبارة Dim db As Database Dim sSQL As String Set db = CurrentDb sSQL = "INSERT INTO table_name " & _ "(column1, column2,...)" & _ "VALUES (value1, value2,....)" db.Execute sSQL الفرق بأن الأولى ستجد نفسك بحاجة الى تعطيل رسائل النظام المزعجة اما في هذه فلن تكون هنالك رسائل نظام مزجعة و لكن يبقى التعامل معها كما في السابق ما يمييز المبرمج المحترف ليس في طول الأكواد و كثرتها فكلما كان الكود مختصر سوف تجد سهولة في التعديل عليه مستقبلا و يكون اكثر مرونة لذا و من وجهة نظهر بأن تستخدم المصفوفات الطريقة المثلى التي قدمتها ما يكروسوفت فهي الأسرع و الأرتب جلب البيانات Dim db As DAO.Database Dim rs As DAO.Recordset ' جلب سطر او سطور حسب المطلوب افضل و اسرع Set rs = CurrentDb.OpenRecordset("SELECT * FROM table_name WHERE column_name = some_value") If Not rs.BOF Then rs.MoveFirst While (Not rs.EOF) [TextBox1] = rs.Fields(0) [TextBox2] = rs.Fields(1) rs.MoveNext Wend End If rs.Close Set rs = Nothing ======================================================================== اضافة البيانات Dim db As DAO.Database Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("table_name") rs.AddNew rs.Fields(0) = [TextBox1] rs.Fields(1) = [TextBox2] rs.Fields(2) = [TextBox3] rs.Update rs.Close Set rs = Nothing ======================================================================== تعديل البيانات Dim db As DAO.Database Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("SELECT * FROM table_name WHERE column_name = some_value") rs.Edit rs.Fields(0) = [TextBox1] rs.Fields(1) = [TextBox2] rs.Fields(2) = [TextBox3] rs.Update rs.Close Set rs = Nothing بالنسبة لهذه النقطة فالخيار الثاني هو الافضل لك بلا منازع و دائما تجب الاتصال المستمر بقاعدة البيانت اتصال يكون عند الحاجة فقط ( اضافة \ حذف \ تحديث \ استدعاء سطور محددة حسب الحاجة )

الاستاذ محمد اشكرك كل الشكر فقد وصلت المعلومه .End(Direction) xlToLeft = 1 xlToRight = 2 xlUp = 3 xlDown = 4 وفعلا رقم 2 تعبر عن cells(2,1) فهل هناك ارقام اخرى لتغيير الخلايا اشكرك اخى محمد

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

حياك الله 🙂 انا وضعت لك الكود جاهز ولا يحتاج تفكير في التطبيق ، بس اسم زر امر توليد الارقام ، اسمه cmd_Generate_Random ، وهذا كود الحدث ، والسلام 🙂 جعفر

عظيم الشكر والامتنان لكل 1- د.كاف يار راعي الاوله مايلح (مثل يعبر عن من سبق الكل) 2- jjafferr (ماشاء الله عليك لكن انا مبندي فعمل ماذكرت صعب علي ) 3-husamwahab (مثالك في قمت الروعه) من ساهم في مساعدتي أو مر على موضوعي ولم يتمكن من المساعده كلمه الشكر لا تفيكم حقكم ولا تعبر مدى امتناني لكم والشكر لكافة اعضاء المنتدى كل عام وانتم دائماً بخير بمناسبة عيد الأضحي وجعل الله عيدكم فرحة وسعادة.

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

اشوفك تتسرّع في تعليقاتك !! ولو تغيّر التعليق الى سؤال ، فبتحصل على اجابات افضل 🙂 الهدف الاكبر من هذا الموضوع هو ، حماية البيانات : 1. اذا البيانات على السيرفر ، والاكسس متصل بجداوله في السيرفر ، فالرابط يكون مستمر بين الواجهة والجداول ، والشاطر يقدر يستعمل احد برامج "الشم" Sniffing والتوصل الى ما يشاء ، 2. بينما اتصالك بالكود للسيرفر وجلب البيانات ، ثم انقطاع الاتصال بالسيرفر ، يجعل الموضوع ذو امان اكثر 🙂 وللعلم ، فهناك العديد من الجهات التي تهتم بأمن البيانات ، تصر على ان تكون جميع كائناتها غير منضمه 🙂 جعفر

تفضل التعديل 2Test_It_0001.zip

شكرا لك أستاذى الفاضل **** نعم هو كذلك جزاكم الله تعالى خير الجزاء

مشاركة مع اساتذتي الاجلاء ملاحظة : الكود يراعي عدم التكرار وللتحقق اختر الارقام من 1 الى 32 CreateNumbers.rar

بالخدمة استاذي العزيز

وعليكم السلام 🙂 اكتب كلمة Randomize في مساعد الاكسس ، وستحصل على الجواب: . ولا تستخدم علامة الناقص في اسماء كائناتك (بل استعمل الشرطه السفليه _ ) ، لأنها في الكود تصبح : . فتضطر الى معالجته بوضع اسم الكائن بين [] : . ولا تستخدم الارقام في تسمية الحقول ، فالاسم لا يظهر في الكود VBE ، مثلا انا طلب الحقل الذي اسمه 1 ، ولكن الكود لا يراه : . ولاحظ ان اخي حسين لم يتعامل مع حقل النموذج مباشرة ، بل تعامل مع الجدول 🙂 وعليه ، وحتى نتعامل مع حقل النموذج ، يصبح الكود : Private Sub cmd_Generate_Random_Click() Dim i As Integer Dim f As Integer Dim e As Integer 'ÇÍÝÙ ÓÌá ÇáäãæÐÌ If Me.Dirty Then Me.Dirty = False f = Me.[f-no] e = Me.[e-no] For i = 1 To 32 Try_Again: Dim MyValue Randomize Timer MyValue = Int((e * Rnd) + f) If MyValue < f Or MyValue > e Then GoTo Try_Again Else Me("[" & i & "]") = MyValue End If Next i End Sub . جعفر

اولا احب اشكرك على مساعدتك الكود يعمل جيدا

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

جرب هذا التعديل توليد رقم عشوائي.accdb

جرب استخدمها بدون تكبير للأرقام مثلا متسلسلة Int(Rnd()) + 1

العفو و تحت أمرك في اي وقت

اتفضل التعديل توليد رقم عشوائي.accdb

لتوليد رقم عشوائي استخدم الدالة Rnd Int(Rnd() * 10000) + 1

تفضل هذه المشاركة برنامجي.mdb

السلام عليكم استاذ ابو الحسن اعتذر منك لتاخري بالرد عليكم فلم الاحظ مشاركتك ولم يصلني اياشعار تفضل التعديل حسب فهمي لطلبك التعديل في نموذج frmUPDate ملاحظة : العلاقات بين الجداول على اساس رقم الحساب فتغيير الاسم يجري من جدول الحسابات وعليه ستلاحظ التغيير في كل النماذج 2300-3.rar

جرب هذا الكود Private Sub أمر1_Click() If Nz(DCount("*", "tblSolaf1", "Paid=No" & " And SolfaDate<=#" & Date & "#"), 0) > 0 Then MsgBox "هناك سلف لم يتم الانتهاء منها", vbInformation, "تنبيه" DoCmd.OpenForm "tblSolaf1" Else DoCmd.OpenForm "Salary" End If End Sub

للرفع

نعم اتضح عدم تجاوز الأشهر المسددة مدة العقد جرب كتابة هذه المعادلة في الأشهر المسددة =IF(DATEDIF(M14,NOW(),"m")+1>L14,L14,DATEDIF(M14,NOW(),"m")+1) ومعناها إذا كان ناتج المعادلة أكبر من عدد شهور العقد فتكون قيمة الخلية عدد شهور العقد فقط ولا يزيد بالتوفيق

سبب إضافة 1 لان التاريخ غالبا بنهاية الشهر ك 25 مثلا فينقص شهر لذا قمت بإضافة العدد 1 للتاريخ .. المشكلة عندي ان عندما ادخل عقد منتي لايتوقف على الاشهر المسددة عند 35 بل يحسب ولو كان قبل سنه فتصبح الاشهر المسددة بدلا من 35 47 35+12=47 وما اريده ان اذا وصل لمدة العقد يتوقف عن العد على مدة العقد كما في الصورة وهو 35 . امل اتضحت لك الصوره اخ محمد

انصحك بالتالي - تقسم قاعدة البيانات ( فصل قاعدة البيانات عن الواجهة ) - استخدام النماذج الغير منضمة خاصة في حال ( الاضافة - الحذف - التحديث ) - في حال وجود نماذج مستمرة قم بإنشاء جدول مماثل لما هو موجود في قاعدة البيانات و يتم ملئ الجدول في حال فتح النموذج و افراغه في حال اغلاق النموذج - وضع نسخة من الواجهة على كل جهاز ( و ليس مشاركة الواجهات ) - في كل الأحوال لا تستخدم الاتصال المستمر بقاعدة اليبانات بل يكون الاتصال وقت الحاجة لها

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

حسب فهمي للمطلوب يمكنك استعمال هذا الكود Private Sub CommandButton5_Click() If ActiveSheet.Name <> "data" Then Dim wslr As Integer, counter As Integer, ws As Worksheet Set ws = ThisWorkbook.Worksheets("data") wslr = ws.Cells(Rows.Count, 1).End(xlUp).Row For counter = 1 To wslr If ws.Cells(counter, 2) = TextBox1.Value Then ws.Cells(counter, 2).EntireRow.Delete counter = counter - 1 End If Next MsgBox "تم حذف الاسم" End If End Sub

تفضل شوف الملف بعد التعديل تÙ_رÙ_ر تسÙ_Ù_Ù_ اÙ_Ù_Ù_اد..xlsx

بعد اذن الاخ محمد فضلا انظر للمرفق v look up.xlsx

السلام عليكم جرب المرفق انتظر الرد v look up.xlsx

وعليكم السلام 🙂 مافي فرق بين نموذج منضم ومرتبط بإستعلام/جدول ، وبين نموذج غير منضم ، الاسرع يكون عند استخدام الطريقة الثالثة من خلال استخدام استعلام اكسس عادي 🙂 فالطريقة الاولى ، الاكسس يحتاج الى ان يعمل Compile لجملة الـ SQL التي ستضعها في الامر ، ثم ينفذ الامر ، والطريقة الثانية تحتاج الى ان تجلب الجدول الى ذاكرة الكمبيوتر العشوائية ، ثم تقوم بالمطلوب 🙂 جعفر

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

الأخ الكريم محبوب من الأفضل أن نناقش جزئية جزئية عشان بتوه في الكلام الكتير مثال SH.Range("H" & SH.Cells(99, 8).End(xlUp).Row + 1) = Cell.Value السطر ده سألت عن SH دا متغير لأي ورقة عمل في المصنف الذي يحوي الكود لأننا بنعمل حلقة تكرارية لكل أوراق العمل .. بمعني مش منطقي إننا هنتعامل مع كل أوراق العمل كل ورقة عمل باسمها .. فبنرمز لأي ورقة بالمتغير ده وطبعا بما إنه متغير فبعد كل حلقة تكرارية ما تنتهي اسم ورقة العمل بيتغير لاسم ورقة عمل جديدة (تصدق أنا نفسي تهت) Cells معناها خلايا بس استخدامها هنا عشان أعرف آخر صف فيه بيانات في العمود رقم 8 يعني مثلا Cells(99, 8) معناها الخلية في العمود رقم 8 والصف رقم 99 End(xlUp) معناها اطلع لفوق .بالظبط زي ما بنضغط Ctrl + سهم لفوق عشان يطلعنا لآخر خلية بها بيانات في نفس العمود (اللي هو في المثال رقم 8) Row عشان نعرف رقم الصف لآخر خلية فيها بيانات زائد 1 عشان ننتقل لأول خلية فارغة في العمود رقم 8 عشان نبدأ ندرج فيه بيانات ... يعني خلاصة الكلام الجزء ده كله SH.Cells(99, 8).End(xlUp).Row + 1 معناه رقم صف أول خلية فارغة ....................! يعني مثلا لو كان ناتج الجزء ده رقم 7 ..الصف السابع مثلا فيه أول خلية فارغة في هذا العمود يبقا ممكن نختصر السطر SH.Range("H7"( ولما نوصل للخلية نخليها تساوي Cell.value الموضوع محتاج وقت عشان تقدر تدرسه كويس ربنا يوفقك

الأخ الكريم محبوب أعتذر عن التأخر في الرد عليك ، فقد كنت منشغلاً .. إليك الشرح عله يفيدك إن شاء الله Sub YasserKhalil() 'تعريف المتغيرات Dim WBK As Workbook Dim SH As Worksheet, WS As Worksheet, Cell As Range 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'إلغاء خاصية رسائل التنبيه Application.DisplayAlerts = False 'سطر لفتح المصنف المسمى حسابات العملاء لجلب البيانات منه Set WBK = Workbooks.Open(ThisWorkbook.Path & "\حسابات العملاء.xlsx") 'حلقة تكرارية لكل أوراق العمل في المصنف الحالي الذي يحوي الكود For Each SH In ThisWorkbook.Sheets 'سطر لاستثناء ورقة العمل المسماة الفهرس من الحلقة التكرارية If SH.Name <> "الفهرس" Then 'مسح محتويات النطاقات المراد جلب البيانات إليها SH.Range("C6:F99,H6:I99").ClearContents 'حلقة تكرارية لكل أوراق العمل في المصنف المسمى حسابات العملاء For Each WS In WBK.Sheets 'سطر لاستثناء ورقة العمل المسماة الفهرس الرئيسي من الحلقة التكرارية If WS.Name <> "الفهرس الرئيسى" Then 'بدء التعامل مع كل ورقة عمل على حدا With WS 'إذا كانت أول خلية تحتوي على التواريخ فارغة يتم الانتقال لورقة العمل التالية If IsEmpty(.Range("A6")) Then GoTo 1 'سطر لتفادي حدوث خطأ أي استمرار عمل الكود في حالة حدوث خطأ On Error Resume Next 'حلقة تكرارية لنطاق التواريخ For Each Cell In .Range("A6:A" & .Cells(Rows.Count, 1).End(xlUp).Row) 'إذا كانت الخلية التي تحتوي على التاريخ ، الشهر بها يساوي رقم الشهر في ورقة العمل في المصنف الحالي 'وكذلك السنة الموجودة في التاريخ تساوي سنة 2015 يتم تنفيذ الأسطر التالية If Month(Cell.Value) = MonthNumber(SH.Name) And Year(Cell.Value) = 2015 Then 'يتم جلب التاريخ ووضعه في العمود الثامن في أوراق العمل في المصنف الحالي SH.Range("H" & SH.Cells(99, 8).End(xlUp).Row + 1) = Cell.Value 'يتم جلب اسم العميل ووضعه في العمود الثالث في أوراق العمل في المصنف الحالي SH.Range("C" & SH.Cells(99, 3).End(xlUp).Row + 1) = .Range("C2").Value 'يتم جلب قيمة القسط ووضعها في العمود الخامس في أوراق العمل في المصنف الحالي SH.Range("E" & SH.Cells(99, 5).End(xlUp).Row + 1) = Cell.Offset(, 2) 'يتم جلب قيمة الكوبري ووضعها في العمود السادس في أوراق العمل في المصنف الحالي SH.Range("F" & SH.Cells(99, 6).End(xlUp).Row + 1) = Cell.Offset(, 3) 'يتم جلب رقم التليفون ووضعه في العمود التاسع في أوراق العمل في المصنف الحالي SH.Range("I" & SH.Cells(99, 9).End(xlUp).Row + 1) = .Range("M8").Value 'انتهاء أسطر الشرط End If 'الانتقال للخلية التالية التي تحوي تاريخ Next Cell 'انتهاء التعامل مع ورقة العمل من المصنف المسمى حسابات العملاء استعداداً للتعامل مع ورقة عمل جديدة 1 End With End If 'الانتقال لورقة عمل جديدة في المنصف المسمى حسابات العملاء Next WS End If 'الانتقال لورقة عمل جديدة في المصنف الحالي Next SH 'إغلاق المصنف المسمى حسابات العملاء بدون حفظ التغييرات WBK.Close SaveChanges:=False 'إعادة تفعيل خاصية رسائل التنبيه Application.DisplayAlerts = True 'إعادة تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub تقبل تحياتي

السلام عليكم ملف للترحيل كان طلب احد الاخوة حبيت ان يراه الجميع لتعم الفائدة ومعرفة الميزات التالية اولا : ورقة الترحيل 1- اذا كانت لديك خلايا متفرقة و تريد جمعها في الكود باختصار Set myRng1 = Range("E6,I8,H6,B8,B10,I10,I11") 2- الفاتورة توجد فيها سبعة صفوف يتم انتقاء الصفوف التي اكبر من اصفر في خانة الاجمالي ليتم ترحيلها For E = 19 To 25 If Cells(E, 1).Value > 0 Then Y = Y + Cells(E, 1).Count End If Next 3- مسح قيم الخلايا بعد الترحيل حتى لو كانت الخلايا مدموجة ولا توجد بها صيغ myRng1.Cells.SpecialCells(xlCellTypeConstants).ClearContents ثانياً: ورقة البيانات تلوين الصف الاول من كل عملية ترحيل للفصل بين البيانات Range("A" & N & ":R" & N).Interior.ColorIndex = 8 اخوكم / خبور خير ____________.rar

السلام عليكم أولا حجم الملف كبيير جدا 5.7 ميجا وبالتالي ثقيل في التعامل ومدة الحسابات كل خطوة لذلك قمت بعد إذنك بتقليل حجمه بما لايتناقض مع المطلوب برجاء مراجعة موضوع تقليل حجم الملف هنا ثانيا تفضل الحل مع ملاحظة يوجد عمود الاسم مع الشهر لونه أصفر في كل من ورقتي مجمل الغياب و البيانات الاساسية يمكنك إخفاؤه من الطباعة فقط ، أنا تركته ظاهر للتوضيح __________4.rar

السلام عليكم تم عمل مشابه لطلبك على الرابط التالي http://www.officena.net/ib/index.php?s=&am...st&p=129836 آمل الإطلاع وان كان ما تريد ممكن شرحة مع التحية

السلام عليكم في المرفق مثال لما فهمت من الطلب أدخلي في الخلايا الصقراء اي قيمة او نص موجود في نفس العمود بعد الإنتقال من الخلية سوف يوصلك الى هذه القيمة او النص الذي طلبتيه فورا مع رسالة تحذير ان لم يكن القيمة موجودة - باستخدام التحققمن صحة واذاكانت الفكرة جيدة يمكن توسيعها للبحث بجزء من الإسم المرفق _______________________ay______.rar