اسامة ابو عمر قام بنشر أبريل 13, 2016 مشاركة قام بنشر أبريل 13, 2016 السلام عليكم بناء على الموضوع السابق اضافة تارخ تلقائي وبعد الشكر الجزيل للاخ محمد عبد السلام على المساعدة عندي دلوقتي اعمدة بتاخد تاريخ تلقائي عند ادخال رقم الفاتورة والاعمد دي هيا L & x & AF انا عايز احمى الاعمدة دي من التغير او التعديل ماخلاص هيا بتاخد التاريخ عند ادخال الفاتورة حاولت احميها بالطريقة العادية بس بيحصل معايا مشكلة بالكود ولما ادخل رقم الفاتور ما بيطلعش التاريخ تلقائي osamahreport2.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أبريل 13, 2016 مشاركة قام بنشر أبريل 13, 2016 أخي الكريم أسامة قم بحذف الأكواد من موديولات أوراق العمل وضع هذا الكود في حدث المصنف فقط Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim Cl As Variant, Dat As Variant Dim DupCtr As Double Dim LastRow As Long If Not Application.Intersect(Target, Columns("A:A")) Is Nothing Then Application.EnableEvents = False If Target.Cells.Count > 1 Then Dat = Target.Formula For Each Cl In Dat If Cl <> "" Then MsgBox "Change Only One Cell At A Time", , "Too Many Changes!" Application.Undo: Application.CutCopyMode = False GoTo Skipper End If Next Cl End If End If Skipper: Application.EnableEvents = True If Target.Column = 10 Then Application.EnableEvents = False Sh.Unprotect 1 Sh.Cells(Target.Row, 12).Value = Date & " " & Time Sh.Range("L:L").EntireColumn.AutoFit ActiveSheet.Protect 1 Application.EnableEvents = True End If If Target.Column = 20 Then Application.EnableEvents = False Sh.Unprotect 1 Sh.Cells(Target.Row, 24).Value = Date & " " & Time Sh.Range("X:X").EntireColumn.AutoFit Sh.Protect 1 Application.EnableEvents = True End If If Target.Column = 29 Then Application.EnableEvents = False Sh.Unprotect 1 Sh.Cells(Target.Row, 32).Value = Date & " " & Time Sh.Range("X:X").EntireColumn.AutoFit Sh.Protect 1 Application.EnableEvents = True End If End Sub حيث سيعمل الكود بهذا الشكل مع كل أوراق العمل بدلاً من عمل الكود لكل ورقة عمل على حدا 2 رابط هذا التعليق شارك More sharing options...
عبدالله فاروق ابو ريان قام بنشر أبريل 13, 2016 مشاركة قام بنشر أبريل 13, 2016 بعد اذت استاذي ياسر خليل كتابة التاريخ والوقت بالمعادلات ويمكنك حمايتها عن طريق تمكين الحساب التكراري كتابة التاريخ والوقت بمجرد كتابة كلمة بالمعادلات.rar 1 رابط هذا التعليق شارك More sharing options...
اسامة ابو عمر قام بنشر أبريل 13, 2016 الكاتب مشاركة قام بنشر أبريل 13, 2016 3 ساعات مضت, ياسر خليل أبو البراء said: أخي الكريم أسامة قم بحذف الأكواد من موديولات أوراق العمل وضع هذا الكود في حدث المصنف فقط Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim Cl As Variant, Dat As Variant Dim DupCtr As Double Dim LastRow As Long If Not Application.Intersect(Target, Columns("A:A")) Is Nothing Then Application.EnableEvents = False If Target.Cells.Count > 1 Then Dat = Target.Formula For Each Cl In Dat If Cl <> "" Then MsgBox "Change Only One Cell At A Time", , "Too Many Changes!" Application.Undo: Application.CutCopyMode = False GoTo Skipper End If Next Cl End If End If Skipper: Application.EnableEvents = True If Target.Column = 10 Then Application.EnableEvents = False Sh.Unprotect 1 Sh.Cells(Target.Row, 12).Value = Date & " " & Time Sh.Range("L:L").EntireColumn.AutoFit ActiveSheet.Protect 1 Application.EnableEvents = True End If If Target.Column = 20 Then Application.EnableEvents = False Sh.Unprotect 1 Sh.Cells(Target.Row, 24).Value = Date & " " & Time Sh.Range("X:X").EntireColumn.AutoFit Sh.Protect 1 Application.EnableEvents = True End If If Target.Column = 29 Then Application.EnableEvents = False Sh.Unprotect 1 Sh.Cells(Target.Row, 32).Value = Date & " " & Time Sh.Range("X:X").EntireColumn.AutoFit Sh.Protect 1 Application.EnableEvents = True End If End Sub حيث سيعمل الكود بهذا الشكل مع كل أوراق العمل بدلاً من عمل الكود لكل ورقة عمل على حدا جزاك الله كل خير اخي ابو البراء 2 ساعات مضت, عبدالله فاروق ابو ريان said: بعد اذت استاذي ياسر خليل كتابة التاريخ والوقت بالمعادلات ويمكنك حمايتها عن طريق تمكين الحساب التكراري كتابة التاريخ والوقت بمجرد كتابة كلمة بالمعادلات.rar شكرا لك اخوي على المساعدة وعلى الفكره الجميلة 1 رابط هذا التعليق شارك More sharing options...
عبدالله فاروق ابو ريان قام بنشر أبريل 13, 2016 مشاركة قام بنشر أبريل 13, 2016 اخي اسامة جزاك الله خيرا 1 رابط هذا التعليق شارك More sharing options...
اسامة ابو عمر قام بنشر أبريل 13, 2016 الكاتب مشاركة قام بنشر أبريل 13, 2016 أخي ياسر عندما طبقت الكود الجديد على جميع الصفحات يحدث معايا مشكلة بالصفحة الرابعه لاني الصفحة الرابعة فيها كود يقوم بنسخ المعلومات من الصفحات الثلاثة الاخرى رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أبريل 13, 2016 مشاركة قام بنشر أبريل 13, 2016 إذاً فلتعد إلى الحالة الأولى وتنسخ الكود في موديول كل ورقة عمل وغير ما يلزم .. التغيير أنك ستحذف الجزء الخاص بتحديد ورقة العمل Sh التي تليها نقطة رابط هذا التعليق شارك More sharing options...
اسامة ابو عمر قام بنشر أبريل 13, 2016 الكاتب مشاركة قام بنشر أبريل 13, 2016 منذ ساعه, ياسر خليل أبو البراء said: إذاً فلتعد إلى الحالة الأولى وتنسخ الكود في موديول كل ورقة عمل وغير ما يلزم .. التغيير أنك ستحذف الجزء الخاص بتحديد ورقة العمل Sh التي تليها نقطة اي تقصد هذا الجزء ؟ Sh.Unprotect 1 Sh.Cells(Target.Row, 32).Value = Date & " " & Time Sh.Range("X:X").EntireColumn.AutoFit Sh.Protect 1 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أبريل 13, 2016 مشاركة قام بنشر أبريل 13, 2016 جرب التعديل بهذا الشكل Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim Cl As Variant, Dat As Variant Dim DupCtr As Double Dim LastRow As Long If Not Application.Intersect(Target, Columns("A:A")) Is Nothing Then Application.EnableEvents = False If Target.Cells.Count > 1 Then Dat = Target.Formula For Each Cl In Dat If Cl <> "" Then MsgBox "Change Only One Cell At A Time", , "Too Many Changes!" Application.Undo: Application.CutCopyMode = False GoTo Skipper End If Next Cl End If End If Skipper: Application.EnableEvents = True If Target.Column = 10 Then Application.EnableEvents = False ActiveSheet.Unprotect 1 Cells(Target.Row, 12).Value = Date & " " & Time Range("L:L").EntireColumn.AutoFit ActiveSheet.Protect 1 Application.EnableEvents = True End If If Target.Column = 20 Then Application.EnableEvents = False ActiveSheet.Unprotect 1 Cells(Target.Row, 24).Value = Date & " " & Time Range("X:X").EntireColumn.AutoFit ActiveSheet.Protect 1 Application.EnableEvents = True End If If Target.Column = 29 Then Application.EnableEvents = False ActiveSheet.Unprotect 1 Cells(Target.Row, 32).Value = Date & " " & Time Range("X:X").EntireColumn.AutoFit ActiveSheet.Protect 1 Application.EnableEvents = True End If End Sub تقبل تحياتي رابط هذا التعليق شارك More sharing options...
اسامة ابو عمر قام بنشر أبريل 13, 2016 الكاتب مشاركة قام بنشر أبريل 13, 2016 42 دقائق مضت, ياسر خليل أبو البراء said: جرب التعديل بهذا الشكل Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim Cl As Variant, Dat As Variant Dim DupCtr As Double Dim LastRow As Long If Not Application.Intersect(Target, Columns("A:A")) Is Nothing Then Application.EnableEvents = False If Target.Cells.Count > 1 Then Dat = Target.Formula For Each Cl In Dat If Cl <> "" Then MsgBox "Change Only One Cell At A Time", , "Too Many Changes!" Application.Undo: Application.CutCopyMode = False GoTo Skipper End If Next Cl End If End If Skipper: Application.EnableEvents = True If Target.Column = 10 Then Application.EnableEvents = False ActiveSheet.Unprotect 1 Cells(Target.Row, 12).Value = Date & " " & Time Range("L:L").EntireColumn.AutoFit ActiveSheet.Protect 1 Application.EnableEvents = True End If If Target.Column = 20 Then Application.EnableEvents = False ActiveSheet.Unprotect 1 Cells(Target.Row, 24).Value = Date & " " & Time Range("X:X").EntireColumn.AutoFit ActiveSheet.Protect 1 Application.EnableEvents = True End If If Target.Column = 29 Then Application.EnableEvents = False ActiveSheet.Unprotect 1 Cells(Target.Row, 32).Value = Date & " " & Time Range("X:X").EntireColumn.AutoFit ActiveSheet.Protect 1 Application.EnableEvents = True End If End Sub تقبل تحياتي لم يزبط لا يوجد حماية والتواريخ تظهر بمكان اخر وتظهر صفر وكود النسخ فيه مشاكل رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أبريل 13, 2016 مشاركة قام بنشر أبريل 13, 2016 أخي الكريم أسامة ارجع للكود الأصلي في ملفك .. كل ما فعلته أنني أضفت سطر لفك الحماية ثم سطر آخر لتفعيل الحماية مع كل حدث خاص بكل عمود ... قم بحماية أوراق العمل الخاصة بك أولاً بكلمة السر 1 قبل وضع الكود ثم ضع الكود في حدث ورقة العمل المطلوبة وجرب مرة أخرى إذا صافك مشكلة فيرجى النقر على كلمة Debug لمعرفة السطر الذي يظهر فيه الخطأ .. حاول مرة أخرى وإن شاء الله تظبط معاك رابط هذا التعليق شارك More sharing options...
اسامة ابو عمر قام بنشر أبريل 13, 2016 الكاتب مشاركة قام بنشر أبريل 13, 2016 34 دقائق مضت, ياسر خليل أبو البراء said: أخي الكريم أسامة ارجع للكود الأصلي في ملفك .. كل ما فعلته أنني أضفت سطر لفك الحماية ثم سطر آخر لتفعيل الحماية مع كل حدث خاص بكل عمود ... قم بحماية أوراق العمل الخاصة بك أولاً بكلمة السر 1 قبل وضع الكود ثم ضع الكود في حدث ورقة العمل المطلوبة وجرب مرة أخرى إذا صافك مشكلة فيرجى النقر على كلمة Debug لمعرفة السطر الذي يظهر فيه الخطأ .. حاول مرة أخرى وإن شاء الله تظبط معاك طبقت نفس الكلام اللي انتا قولتو التاريخ راح الخطأ بس التاريخ مش بيظهر لما اكتب رقم الفاتورة رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أبريل 13, 2016 مشاركة قام بنشر أبريل 13, 2016 بالنسبة لأكواد حدث التغير في ورقة العمل يفضل حفظ المصنف بعد وضع الأكواد ثم إعادة فتح المصنف مرة أخرى .. احمي ورقة العمل بكلمة السر 1 ثم احفظ المصنف ثم أعد فتحه مرة أخرى 1 رابط هذا التعليق شارك More sharing options...
اسامة ابو عمر قام بنشر أبريل 13, 2016 الكاتب مشاركة قام بنشر أبريل 13, 2016 8 دقائق مضت, ياسر خليل أبو البراء said: بالنسبة لأكواد حدث التغير في ورقة العمل يفضل حفظ المصنف بعد وضع الأكواد ثم إعادة فتح المصنف مرة أخرى .. احمي ورقة العمل بكلمة السر 1 ثم احفظ المصنف ثم أعد فتحه مرة أخرى سأحوال .... شكرا لك على تعبك معايا رابط هذا التعليق شارك More sharing options...
اسامة ابو عمر قام بنشر أبريل 14, 2016 الكاتب مشاركة قام بنشر أبريل 14, 2016 11 ساعات مضت, اسامة ابو عمر said: سأحوال .... شكرا لك على تعبك معايا 11 ساعات مضت, ياسر خليل أبو البراء said: بالنسبة لأكواد حدث التغير في ورقة العمل يفضل حفظ المصنف بعد وضع الأكواد ثم إعادة فتح المصنف مرة أخرى .. احمي ورقة العمل بكلمة السر 1 ثم احفظ المصنف ثم أعد فتحه مرة أخرى الحمايةزبطت بس مش بتاخد تاريخ عند اضافة رقم الفاتورة رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أبريل 14, 2016 مشاركة قام بنشر أبريل 14, 2016 طيب قبل إضافة الحماية هل كان الكود يعمل بشكل جيد يرجى إرفاق آخر نسخة من الملف للإطلاع عليه 1 رابط هذا التعليق شارك More sharing options...
ا بو سليمان قام بنشر أبريل 14, 2016 مشاركة قام بنشر أبريل 14, 2016 ما شاء الله على التعاون بين الاحبة 1 رابط هذا التعليق شارك More sharing options...
اسامة ابو عمر قام بنشر أبريل 14, 2016 الكاتب مشاركة قام بنشر أبريل 14, 2016 42 دقائق مضت, ياسر خليل أبو البراء said: طيب قبل إضافة الحماية هل كان الكود يعمل بشكل جيد يرجى إرفاق آخر نسخة من الملف للإطلاع عليه نعم هنا الملف يعمل بشكل صحيح بس ينقصحه حماية الخلايا التى تحتوي على التاريخ التى تؤخذ بشكل تلقائي عند ادخال رقم الفاتورة osamahreport2.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أبريل 14, 2016 مشاركة قام بنشر أبريل 14, 2016 جرب الكود بهذا الشكل بعد عمل حماية لورية العمل بكلمة السر 1 Private Sub Worksheet_change(ByVal Target As Range) Dim Cl As Variant, Dat As Variant Dim DupCtr As Double Dim LastRow As Long If Not Application.Intersect(Target, Columns("A:A")) Is Nothing Then Application.EnableEvents = False If Target.Cells.Count > 1 Then Dat = Target.Formula For Each Cl In Dat If Cl <> "" Then MsgBox "Change Only One Cell At A Time", , "Too Many Changes!" Application.Undo: Application.CutCopyMode = False GoTo Skipper End If Next Cl End If '========================================================================= End If Skipper: Application.EnableEvents = False ActiveSheet.Unprotect 1 If Target.Column = 10 Then Cells(Target.Row, 12).Value = Date & " " & Time Range("L:L").EntireColumn.AutoFit ElseIf Target.Column = 20 Then Cells(Target.Row, 24).Value = Date & " " & Time Range("X:X").EntireColumn.AutoFit ElseIf Target.Column = 29 Then Cells(Target.Row, 32).Value = Date & " " & Time Range("X:X").EntireColumn.AutoFit End If ActiveSheet.Protect 1 Application.EnableEvents = True End Sub Sub salim() ActiveSheet.Unprotect "salim" lr = Cells(Rows.Count, 1).End(3).Row + 1 With ActiveSheet.Range("A2:b" & lr) .Cells.Locked = True .Cells.SpecialCells(xlCellTypeBlanks).Locked = False End With Columns("C:xfd").Locked = False ActiveSheet.Protect "salim" End Sub رابط هذا التعليق شارك More sharing options...
اسامة ابو عمر قام بنشر أبريل 14, 2016 الكاتب مشاركة قام بنشر أبريل 14, 2016 انا ححط المعلومات واجرب واشوف رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.