رجب جاويش

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

تفضل أخى الترحيل.rar

تفضل أخى ابراهيم STAT.rar

أختى الفاضلة / هبه مصطفى جربى ازالة السطرين Application.ScreenUpdating = False Application.ScreenUpdating = True

أخى الفاضل ارفق ملف ليتم عمل ما تريد عليه

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

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

تفضل أخى Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [G18:K51]) Is Nothing Then Dim LR As Integer, cl As Range Application.ScreenUpdating = False Range("2:2").ClearContents ReDim Arr(1 To 170) As Integer T = 1 For Each cl In [G18:G51,H18:H51,I18:I51,J18:J51,K18:K51] Arr(T) = cl T = T + 1 Next ii = 2 For Each c In Arr Cells(2, ii) = c ii = ii + 1 Next Application.ScreenUpdating = True End If End Sub دفتر النقل.rar

يمكنك حذف الملف الاصلي لانه ليس له اي ارتباط بالملف الاخر

أختى الفاضلة جزاك الله كل خير على هذه الكلمات الطيبة نعم كثرة المعادلات وكثرة البيانات تعمل على بطئ عمل الملف ممكن استبدال بعض المعادلات بأكواد ممكن ذلك يؤدى الى زيادة سرعة الملف فى العمل

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

لجعل الكود لا يعمل على الشيت الأول والثانى ضع السطر التالى If ActiveSheet.Name = "Sheet1" Or ActiveSheet.Name = "Sheet2" Then Exit Sub بدلا من السطر If ActiveSheet.Name = "Sheet3" Then Exit Sub مع تغير أسماء الشيتات sheet1 و sheet2 بما يناسب أسماء الشيتات فى الملف الخاص بك اذا كانت لها أسماء مختلفة بالنسبة للسؤال الثانى سؤالك يوضح أنك تستعمل أوفيس 2007 أو 2010 فيمكنك عند حفظ الملف اختيار excel 97 - 2003 workbook أو اختيار excelmacro -enable workbook فهذه الاختيارات تدعم وجود الأكواد

بالنسبة للطلب الأول وهو تطبيق الكود على جميع الشيتات ما عدا شيت محدد الكود التالى يطبق على الشيتات 1 و 2 فقط ولا يطبق على شيت 3 يمكنك عمل نفس الفكرة Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If ActiveSheet.Name = "Sheet3" Then Exit Sub If Target.Column = 1 Then Target.Offset(0, 1).Value = Now() End If End Sub أما بالنسبة للسؤال الثانى فان الملف المرفق له امتداد xls وهذا الامتداد يدعم وجود الأكواد وأيضا الامتداد xlsm أما الامتداد الذى لا يدعم الأكواد هو xlsx Now.rar

أختى الفاضلة جربى هذا التعديل وهو يترك المعادلة كما هى ولا يحذفها Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 22 Or Target.Count > 1 Or Target.Row < 6 Then Exit Sub Application.ScreenUpdating = False If Target = "" Then Exit Sub On Error Resume Next If Target.Offset(0, -9).Value = 0 Then Target.Value = "" MsgBox "من فضلك أدخل القيمة أولا" Target.Select: Exit Sub End If If Target.Offset(0, -9).Value <> 0 Then Target = Format(Target, "DD/mm/YYYY") End If Application.ScreenUpdating = True End Sub

يتم ذلك أخى الفاضل كما فى الملف السابق بوضع الكود فى حدث الـ Workbook كالآتى Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Column = 1 Then Target.Offset(0, 1).Value = Now() End If End Sub وبالتالى يعمل مع كل الشيتات كما تريد

هل تقصد هكذا Now.rar

أخى الفاضل / كعبلاوى أرجو التوضيح أكثر فان الملف يعمل عندى تمام

أخى الفاضل أهلا بك فى المنتدى الرجاء ارفاق ملف توضح به ما تريد

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

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

تفضل أخى الترحيل.rar

تفضل أخى سؤال.rar

أختى الفاضلة جربى هذا التعديل وان شاء الله يعمل تمام Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 22 Or Target.Count > 1 Then Exit Sub If Target = "" Then Exit Sub On Error Resume Next If Target.Offset(0, -9).Value = 0 Then Target.Value = "" Target.Offset(0, -9).Value = "" MsgBox "من فضلك أدخل القيمة أولا" Target.Select: Exit Sub End If If Target.Offset(0, -9).Value <> 0 Then Target = Format(Target, "DD/mm/YYYY") End If End Sub

أختى الفاضلة الملف يعمل معى تمام حاولى ادخال القيمة فى العمود A والتاريخ فى العمود B

أخى الفاضل نفذ نفس ما جاء فى فيديو الأستاذ / بن عليه مع استبدال الرقم 0 بالرقم 0100