اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

السلام عليكم

عندى ملف اكسيل 2003 بالشركة يعمل عليه كل الموظفين

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

مع العلم ان طريقه

Tools => Protect Sheet = > Protection

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

و جزاكم الله خيرا

  • Like 1
قام بنشر

عليكم السلام ورحمة الله وبركاته

الاخ الفاضل أو حبيبة

يمكن ان تضع الكود التالي في الورقة التي بها المعادلات

ولن يتم الوقوف على الخلية التي بها معادلات ستتخطاها وتقف على الخلية الفارغة

اتمني ان يفيدك هذا بطلبك

Private Sub Worksheet_Selectionchange(ByVal Target As Range)
If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select
End Sub

  • Like 1
قام بنشر

وأيضا يمكنك استخدام هذا الكود به رسالة تنبيه

Private Sub Worksheet_Selectionchange(ByVal Target As Range)
If Not Intersect(Target, [a1:iv36536]) Is Nothing Then
If Target.HasFormula Then MsgBox "عفوا ليس لديك الصلاحية للتعديل"
End If
End Sub

قام بنشر (معدل)

السلام عليكم استاذ / وليـــد

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

و جزاك الله خيرا

تم تعديل بواسطه أبــو حبيبـــة
قام بنشر

عليكم السلام ورحمة الله وبركاته

جرب اخي الفاضل الكود التالي لاحد الاساتذة الافاضل بالمنتدي لا اتذكر بالتحديد لمين

مع ملاحظة انه يجب تسمية النطاق الذي يوجد به معادلا باسم (myrange)

عن طريق تظليلها واذا كانت بعيده عن بعضها استخدم مفتاح Ctrl

Private Sub Worksheet_Change(ByVal Target As Range)
If Me.[T1] Then Exit Sub
  If Not Application.Intersect(Target, Range("myrange")) Is Nothing Then

      Application.EnableEvents = False
      Application.Undo
      Application.EnableEvents = True
  MsgBox "عفوا ليس لديك الصلاحية للتعديل"
 End If
End Sub

  • Like 2
قام بنشر

السادة الاعضاء

السلام عليكم ورحمة الله

بتجربة الطريقة الاولي

ينتقل المؤشر الي اخر خلية غير مؤمنة في الصف

وذلك يسبب مشكلة في حالة الرغية الي الانتقال الي الخلية غير المؤمنة التالية في العمود

يمكن الاعتماد علي ما يوفره الاكسيل

بتحديد خانات السماح لمستخدمي ورقة العمل بـ

تنسيق الخلايا او تنسيق الاعمدة او تنسيق الصفوف او الفلتره او الفرز

 

تنسيق.bmp

  • Like 1
قام بنشر

السلام عليكم استاذ / وليـــد

لم استطيع عمل النطاق

فهل من الممكن عمل الكود فى مرفق كمثال توضيحى

و جزاك الله خيرا

 

عليكم السلام ورحمة الله وبركاته

اتفضل استاذ ابو حبيبة

الملف الذي قمت بتحميله سابقا من المنتدي به طلبك

كود لحماية أكثر من نطاق بدون حماية الورقة_2.rar

قام بنشر

السلام عليكم ورحمة الله وبركاته

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

كما اشكر الاستاذ الفاضل // أحمد أبو زيزو صاحب الشروحات البسيطة المفيدة

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

ولهذا فسيكون الناتج كالتالي

1 ) يعطي خاصية الوقوف على الخلية المحمية

2 ) ثم اعطاء الرسالة التحذيرية

3 ) وعند الضغط على ok ينتقل الى الخلية المجاورة

Private Sub Worksheet_Selectionchange(ByVal Target As Range)
If Not Intersect(Target, [a1:iv36536]) Is Nothing Then
If Target.HasFormula Then MsgBox "عفوا ليس لديك الصلاحية للتعديل"
If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select
End If
End Sub

ملحوظة : اذا كان الاكسيل لديكم  اصدار اعلى من 2003 يمكن استبدال هذا الجزء في الكود

[a1:iv36536]

بهذا الجزء ليشمل جميع خلايا الورقة

[a1:xfd1048576]
  • Like 1
قام بنشر

 

السلام عليكم ورحمة الله وبركاته

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

كما اشكر الاستاذ الفاضل // أحمد أبو زيزو صاحب الشروحات البسيطة المفيدة

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

ولهذا فسيكون الناتج كالتالي

1 ) يعطي خاصية الوقوف على الخلية المحمية

2 ) ثم اعطاء الرسالة التحذيرية

3 ) وعند الضغط على ok ينتقل الى الخلية المجاورة

Private Sub Worksheet_Selectionchange(ByVal Target As Range)
If Not Intersect(Target, [a1:iv36536]) Is Nothing Then
If Target.HasFormula Then MsgBox "عفوا ليس لديك الصلاحية للتعديل"
If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select
End If
End Sub

ملحوظة : اذا كان الاكسيل لديكم  اصدار اعلى من 2003 يمكن استبدال هذا الجزء في الكود

[a1:iv36536]

بهذا الجزء ليشمل جميع خلايا الورقة

[a1:xfd1048576]

 

عليكم السلام ورحمة الله وبركاته

أخي وحبيبي في الله محمد أبو البراء

الشكر لك للمساتك الجمالية لاي موضوع

جزاك الله كل خير وزادك من علمه

لكل كل تحيه وتقدير

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information