علي السحيب

المرفق يحتوي على كود يقوم بإخراج المعلومات الخاصة بالملف: 1- إسم الملف. 2- مساره. 3- إسم منشئه. 4- تاريخ ووقت إنشاءه. 5- تاريخ ووقت آخر وصول للملف. 6- تاريخ ووقت آخر تعديل على الملف. 7- إسم المستخدم الذي أدخل تعديلات على الملف. 8- إسم الشخص الذي تم آخر وصول من خلاله. أتمنى أن يحوز على إستحسانكم, Show_File_Access_Information.rar

تم الإضافة، أي أنك عندما تذهب لصفحة أخرى وترجع للصفحة الأولى سوف يتم زيادة العدد الموجود في C3 بمقدار 1 .. (يحسب عدد مرات وقوفك على هذه الصفحة) .. ولذلك قمت بإضافة صفحة جديدة لتجربة ذلك. تم عمل ذلك، لا أعتقد ذلك .. لأن كلاهما يعطي تاريخ اليوم الذي تم فيه فتح الملف .. ويمكنك مراجعة الكود إذا أحببت. - العداد الخاص بعدد مرات تحديث الصفحة يتحدث بمجرد الإنتقال إلى صفحة أخرى والرجوع إلى نفس الصفحة. - العداد الخاص بعدد مرات فتح الملف وتاريخ آخر وصول .. يتحدثان مباشرة عند فتح الملف. - العداد الخاص بتاريخ آخر تعديل .. يتحدث عند حفظ الملف. لا فرق بينهما .. ولكن الكود الذي يعمل عليهما يقوم بتجاهل الخلايا التي بينهما. _______________________.rar

لم أستوعب الفكرة تماماً .. صمم ما تريده بالضبط على ملف وأشرح فيه الفكرة بشكل كامل .. وضعه هنا .. وإن شاء الله يتم تنفيذ كل ما تريد،

شاهد المرفق، CopyCurrentRecord.rar

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

الصيغة التي أشرت إليها غير منطقية تماماً .. ولم أفهم منها ما تريد الوصول إليها بالضبط .. على كل حال .. لتجنب مضيغة الوقت أُفضل أن تقوم بوضع الشروط التي تريدها وحينها فقط أستطيع أن أزودك بالصيغة التي تحتاج.. وبخصوص الدالة AND: AND .. تعني و .. وهي تستخدم لدمج شرطين أو أكثر حتى 32 شرط .. لتحقق نتيجة معينة .. كأن نقول : إذا كان الجنس ذكر وإذا كان العمر أكبر من أو يساوي 18 .. فالنتيجة (يستحق مكافأة) - وإلا فإنه (لا يستحق مكافأة) ..كما في الصيغة التالية: =IF(AND(A4="ذكر",B4>=18),"يستحق مكافأة","لا يستحق مكافأة") شكراً،

نفس الكود المستخدم في المشاركة الأولى .. فقط يتم إضافة إسم الورقة التي تحتوي على البيانات الأساسية إلى نطاق البحث الموجود في الكود .. فيصبح الكود كالتالي: Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo NotAvailable TC = Target.Column TR = Target.Row T = Target If TC = 2 And TR > 7 And T <> "" Then For A = 3 To 10 For B = 2 To 9 Cells(TR, A) = Application.WorksheetFunction.VLookup(T, Sheet1.[B8:J11], B, 0) Next Next End If Exit Sub NotAvailable: If Err <> 0 Then For C = 2 To 10 Cells(TR, C).ClearContents Next MsgBox "الرقم الذي أدخلته غير موجود في قاعدة البيانات", vbExclamation, "رقم غير موجود" Exit Sub End If End Sub Vlookup_in_VBA______________________.rar

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

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

شاهد المرفق، _______________________.rar

شاهد المرفق، _______________________________________________.rar

أي ملف إكسل تتكلم عنه؟؟

هل هذا ما تقصد، ________________________.rar

الكود التالي ينفذ لك ما تريد، Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo NotAvailable TC = Target.Column TR = Target.Row T = Target If TC = 2 And TR > 21 And T <> "" Then For A = 3 To 10 For B = 2 To 9 Cells(TR, A) = Application.WorksheetFunction.VLookup(T, [B8:J11], B, 0) Next Next End If Exit Sub NotAvailable: If Err <> 0 Then For C = 2 To 10 Cells(TR, C).ClearContents Next MsgBox "الرقم الذي أدخلته غير موجود في قاعدة البيانات", vbExclamation, "رقم غير موجود" Exit Sub End If End Sub Vlookup_in_VBA______________________.rar

أبحث في المنتدى عن كلمة التفقيط.

تم التعديل ,, شاهد المرفق، UserForm_TextBox_MaxLength.rar

شاهد المرفق والذي يحتوي على الكود التالي الذي يمكنك من تحديد 11 حالة أو أكثر للتنسيق الشرطي: Private Sub Worksheet_Change(ByVal Target As Range) Dim MyRange As Range Dim Cell As Range Set MyRange = [B3:F15] For Each Cell In MyRange If Cell = "Ali" Then Cell.Interior.ColorIndex = 5 If Cell = "Sameer" Then Cell.Interior.ColorIndex = 10 If Cell = "Mhmed" Then Cell.Interior.ColorIndex = 15 If Cell = "Saleh" Then Cell.Interior.ColorIndex = 20 If Cell = "Hassan" Then Cell.Interior.ColorIndex = 25 If Cell = "Hamad" Then Cell.Interior.ColorIndex = 30 If Cell = "Khalid" Then Cell.Interior.ColorIndex = 35 If Cell = "Moneer" Then Cell.Interior.ColorIndex = 40 If Cell = "Mahdi" Then Cell.Interior.ColorIndex = 45 If Cell = Date Then Cell.Interior.ColorIndex = 50 If Cell = "Yousef" Then Cell.Interior.ColorIndex = 55 Next End Sub AND .. تعني و .. وهي تستخدم لدمج شرطين أو أكثر حتى 32 شرط .. لتحقق نتيجة معينة .. كأن نقول :: إذا كان الجنس ذكر وإذا كان العمر أكبر من أو يساوي 18 .. فالنتيجة (يستحق مكافأة) - وإلا فإنه (لا يستحق مكافأة) ..كما في الصيغة التالية: =IF(AND(A4="ذكر",B4>=18),"يستحق مكافأة","لا يستحق مكافأة") Conditional_Formatting_in_VBA.rar

1- قم بتظليل الخلايا التي تحتاجها من الصف الأول والتي تم تطبيق التنسيق الشرطي عليها ثم أنسخها. 2- قم بتضليل الخلايا المقابة لها من الصف الثاني. 3- إضغط على Shift + Ctrl وأضغط على السهم السفلي مرتين وسيتم إختيار كامل الصفحة. 4- إضغط على المنطقة المضللة بزر الفأرة الأيمن وأختر لصق خاص ثم لصق التنسيق. وبهذا سوف يتم نسخ التنسيق على كامل الخلايا. الصيغة التالية تعطيك رقم الصف الذي توجد به الصيغة: =ROW() الصيغة الأولى في التنسيق الشرطي تقوم بقسمة رقم الصف على 2 .. وتستخرج الباقي .. فإذا كان رقم الصف فردي فإن الباقي سوف يكون 1 .. وبهذا يتحقق الشرط .. وإذا كان رقم الصف زوجي سوف يكون الباقي 0 ..وبهذا لن يتحقق الشرط. والعكس صحيح بالنسبة للصيغة الثانية،

It is working perfectly with me >> I suggest you to send your file to implement the formula on it. Thanx,

تم إجراء التعديل اللازم .. شاهد المرفق، UserForm_TextBox_MaxLength.rar

بعد تعديل بسيط على الصيغة .. (تغيير مكان بعض الأقواس) =IF($G6=-1,IF(INT((C7+$C$3))/$C$3<F6,INT((C7+$C$3)/$C$3)*F6,INT((C7+$C$3)/$C$3))) أتمنى أن يكون هذا ما تريد فعلاً،

أقل من سطر واحد في شريط الصيغ تعتبره طويلاً!!! .. أعتقد أنك لم ترى بعض الصيغ التي تتكون من خمس أو ست أسطر .. كهذه الصيغة مثلاً: =IF(OR($C$10="",$E$10="",$G$10=""),"",IF(L1="","الرجاء إختيار نوع التاريخ أولاً",IF(B13=TODAY(),"لم يكتمل يوم واحد على الولادة",IF(B13>TODAY(),"التاريخ المُدخل أكبر من تاريخ هذا اليوم",IF(SUM(K12:K14)=1,"العمر هو "&L10&M10&" فقط","العمر هو "&L10&M10)))))&IF(AND($C$10="",$E$10="",$G$10=""),"جميع الحقول المطلوب تعبئتها لا تزال فارغة",IF(AND(C10<>"",E10="",G10=""),"أدخل الآن شهر وسنة الميلاد",IF(AND(E10<>"",C10="",G10=""),"أدخل الآن يوم وسنة الميلاد",IF(AND(G10<>"",E10="",C10=""),"أدخل الآن يوم وشهر الميلاد",IF(AND(C10="",E10<>"",G10<>""),"بقي عليك أن تُدخل يوم الميلاد",IF(AND(E10="",C10<>"",G10<>""),"بقي عليك أن تُدخل شهر الميلاد",IF(AND(G10="",E10<>"",C10<>""),"بقي عليك أن تُدخل سنة الميلاد",""))))))) على كل حال ليس المهم أن تكون الصيغة قصيرة .. المهم أن تعمل بشكل جيد ومتكامل كما رأيت .. ولو أن بعض العناصر في الصيغة ليس لها فائدة .. لما وضعتها ..

مستحيل .. لقد قمت قبل قليل بإدراج صف جديد بين الصفوف الموجودة مسبقاً .. وقمت بالضغط على زر الترقيم التسلسلي وتم ترقيم جميع الصفوف ومن ضمنها الصف الجديد بشكل طبيعي وممتاز. وأعتقد أنه لم يتم ترقيم الصف الجديد الذي أدرجته .. لأنه خالي من البيانات والترقيم يعتمد على ضرورة وجود بيانات في الخلية الثانية من الصف (الاسم) ليتم ترقيمه.. والآن جرب الكتابة في الخلية الثانية ثم اضغط على زر الترقيم وأخبرني عن النتيجة. الفائدة هو تحديث الترقيم التسلسلي عند إدراج صف جديد أو حذف صف موجود مسبقاً .. وهذا بالضبط ما احتجت أنت إليه عندما قمت بإدراج صف جديد .. أليس كذلك. نعم نجحت ولكنها تعطي أرقام تسلسلية لصفوف فارغة .. أليس كذلك؟؟ على كل حال المرفق يحتوي على طريقتين من الترقيم التسلسلي وهما كالتالي: 1- ترقيم كل صف على حدا .. بعبارة أخرى أنه يتم الترقيم عندما تنتهي من كتابة الاسم وهذا هو الكود الخاص به: Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Ali TC = Target.Column TR = Target.Row T = Target If TC = 2 And TR > 1 And T <> "" Then Cells(TR, 1) = Cells(TR, 1).Row - 1 Ali: If Err <> 0 Then Exit Sub End Sub 2- ترقيم جميع الصفوف التي تحتوي على أسماء دفعة واحدة .. وهذا هو الكود الخاص به: Sub Numbering() [A2:A100].ClearContents For A = 2 To 100 If Sheet1.Cells(A, 2) <> "" Then Sheet1.Cells(A, 1) = Sheet1.Cells(A, 1).Row - 1 Next End Sub أتمنى أن يكون هذا ما تريده، ________________________.rar

الكود صحيح وهو يقوم بطباعة ورقة العمل 2 .. أليس هذا ما أشرت إليه؟؟؟؟!!!!!!!