اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

تنفيذ الكود مع وجود حمايه للشيتات


إذهب إلى أفضل إجابة Solved by حمادة عمر,

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

يوجد كود يتم تنفيذه على اكثر من شيت دفعه واحده وجميع الشيتات محميه بكلمه سر

كيف يمكن تنفيز الكود مع وجود الحمايه

Sub delete_datas()
    Application.ScreenUpdating = False
    sama = MsgBox("ÓíÊã ÍÐÝ ÈíÇäÇÊ ÇáÔíÊÇÊ ÇáÃÑÈÚÉ (ÇáÇÊæÈíÓ-ØÇÆÑÉ-ãØÑæÍ-ÊÚÏíá)... åá ÃäÊ ãÊÃßÏ ãä ÅÌÑÇÁ åÐå ÇáÚãáíÉ ¿", vbYesNo)
    If sama = vbYes Then
        For Each Sh In Worksheets
            If Sh.Name Like "ÊÚÏíá" Or Sh.Name Like "ÇáÇÊæÈíÓ" _
            Or Sh.Name Like "ãØÑæÍ" Or Sh.Name Like "ØÇÆÑÉ" _
            Then Sh.Select: Range("B5:B40" & ",H5:H40" & ",J5:J40" & ",O5:O40").ClearContents
        Next
    Else
        MsgBox "!! áã íÊã ÇáÊÝÑíÛ"
    End If
    Application.ScreenUpdating = True
    Sheets("ÚÇã").Select
End Sub

برجاء المساعده

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

 

 Sheets("SCH.").Unprotect "2191612""""""""""""""""""""""""""" 

رابط هذا التعليق
شارك

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

       ActiveSheet.Unprotect Password :-"كلمة السر"

وايضا هذا السطر بنهاية الكود

       ActiveSheet.protect Password :- "كلمة السر"

تم تعديل بواسطه وليد فتحي
رابط هذا التعليق
شارك

اخى الحبيب

عند تنفيز الاسطر السابقه تظهر مشكله

وعند البحث وجت  ان الاسطر لابد ان تكون

 "كلمة السر"= ActiveSheet.Unprotect Password  
"كلمة السر"= ActiveSheet.protect Password 

 

 

ولاكنى لا استطيع تنفيزها على الكود السابق

Sub delete_datas()
    Application.ScreenUpdating = False
       sama = MsgBox("سيتم حذف بيانات الشيتات الأربعة (الاتوبيس-طائرة-مطروح-تعديل)... هل أنت متأكد من إجراء هذه العملية ؟", vbYesNo)
    If sama = vbYes Then
        For Each Sh In Worksheets
            If Sh.Name Like "تعديل" Or Sh.Name Like "الاتوبيس" _
            Or Sh.Name Like "مطروح" Or Sh.Name Like "طائرة" _
            Then Sh.Select: Range("B5:B40" & ",H5:H40" & ",J5:J40" & ",O5:O40").ClearContents
        Next
    Else
        MsgBox "!! لم يتم التفريغ"
    End If
    Application.ScreenUpdating = True
         Sheets("عام").Select
End Sub

 

ارجو المساعده

رابط هذا التعليق
شارك

اخى الحبيب

عند تنفيز الاسطر السابقه تظهر مشكله

وعند البحث وجت  ان الاسطر لابد ان تكون

 "كلمة السر"= ActiveSheet.Unprotect Password  
"كلمة السر"= ActiveSheet.protect Password 

 

 

ولاكنى لا استطيع تنفيزها على الكود السابق

Sub delete_datas()
    Application.ScreenUpdating = False
       sama = MsgBox("سيتم حذف بيانات الشيتات الأربعة (الاتوبيس-طائرة-مطروح-تعديل)... هل أنت متأكد من إجراء هذه العملية ؟", vbYesNo)
    If sama = vbYes Then
        For Each Sh In Worksheets
            If Sh.Name Like "تعديل" Or Sh.Name Like "الاتوبيس" _
            Or Sh.Name Like "مطروح" Or Sh.Name Like "طائرة" _
            Then Sh.Select: Range("B5:B40" & ",H5:H40" & ",J5:J40" & ",O5:O40").ClearContents
        Next
    Else
        MsgBox "!! لم يتم التفريغ"
    End If
    Application.ScreenUpdating = True
         Sheets("عام").Select
End Sub

 

ارجو المساعده

 

 

اتفضل اخي الحبيب على اساس ان كلمة السر هي 123

Sub delete_datas()
    Application.ScreenUpdating = False
        

       sama = MsgBox("سيتم حذف بيانات الشيتات الأربعة (الاتوبيس-طائرة-مطروح-تعديل)... هل أنت متأكد من إجراء هذه العملية ؟", vbYesNo)
    If sama = vbYes Then
ActiveSheet.Unprotect Password:=123        
For Each Sh In Worksheets
            If Sh.Name Like "تعديل" Or Sh.Name Like "الاتوبيس" _
            Or Sh.Name Like "مطروح" Or Sh.Name Like "طائرة" _
            Then Sh.Select: Range("B5:B40" & ",H5:H40" & ",J5:J40" & ",O5:O40").ClearContents
        Next
ActiveSheet.protect Password:=123

    Else
        MsgBox "!! لم يتم التفريغ"
    End If
    Application.ScreenUpdating = True
         Sheets("عام").Select
End Sub


تم تعديل بواسطه وليد فتحي
رابط هذا التعليق
شارك

اخى العزيز

يظهر run-time error 1004

ويتم تلوين

: Range("B5:B40" & ",H5:H40" & ",J5:J40" & ",O5:O40").ClearContents

بالون  الاصفر

لا اعلم ما المشكله

رابط هذا التعليق
شارك

  • أفضل إجابة

السلام عليكم

الاخ الكريم / ۩◊۩ أبو حنين ۩◊۩

بارك الله فيك

بعد اذن اخي الفاضل /  وليد فتحي ... جزاه الله خيرا

استخدم التعديل التالي علي الكود الخاص بك لتنفيذ طلبك

Sub delete_datas()
  Application.ScreenUpdating = False
  sama = MsgBox("سيتم حذف بيانات الشيتات الأربعة (الاتوبيس-طائرة-مطروح-تعديل)... هل أنت متأكد من إجراء هذه العملية ؟", vbYesNo)
    If sama = vbYes Then
'=============================
On Error Resume Next
   For i = 2 To Sheets.Count
      Sheets(i).Select
      ActiveSheet.Unprotect ("1")
 Next i
'=============================
        For Each Sh In Worksheets
            If Sh.Name Like "تعديل" Or Sh.Name Like "الاتوبيس" _
            Or Sh.Name Like "مطروح" Or Sh.Name Like "طائرة" _
            Then Sh.Select: Range("B5:B40" & ",H5:H40" & ",J5:J40" & ",O5:O40").ClearContents
        Next
    Else
        MsgBox "!! لم يتم التفريغ"
    End If
'=============================
On Error Resume Next
    For i = 2 To Sheets.Count
        Sheets(i).Select
      Sheets(i).Select
      ActiveSheet.Protect ("1")
    Next i
'=============================
    Application.ScreenUpdating = True
         Sheets("عام").Select
End Sub

وان شاء الله سينفع معك

او قم بوضع ملف كمثال للعمل عليه

تقبل خالص تحياتي

وجرب علي المرفقات

 

 

 

تنفيذ كود مسح بيانات من شيتات مع حماية هذه الشيتات.rar

  • Like 4
رابط هذا التعليق
شارك

السلام عليكم

اخي الفاضل / وليد فتحي

تقبل خالص تحياتي

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

رابط هذا التعليق
شارك

السلام عليكم

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

واخى الحبيب حماده عمر... سلمت يدااك

تم الامر بصوره صحيحه ...جزاك الله كل الخير .

وبرجاء توضيح اين الخطاء للتعلم ...فانت استاذ لنا.. نتعلم منك كل صحيح

رابط هذا التعليق
شارك

السلام عليكم

الاخ الكريم / ۩◊۩ أبو حنين ۩◊۩

بارك الله فيك

بالنسبة للشرح واين الخطأ ...

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

Range("B5:B40" & ",H5:H40" & ",J5:J40" & ",O5:O40").ClearContents

وفي نفس الوقت تقوم بحماية الشيتات من التعديلات ... فبالتالي عند تنفيذ الكود لعملية المسح .. سيتوقف ... حيث ان الشيت المحدد او الشيتات المحددة

لعمل الكود محمية من التعديل

 

وبالنسبة للكود ( السطر ) المستخدم منكم او من الاخ الفاضل / وليد فتحي

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

وبالتالي تظهر معك الرسالة الخاصة بمسح المحتويات المطلوبة في الشيتات المحددة  .. حيث انه لم يتم ازاله الحماية عنها لتنفيذ الكود ومسح البيانات

 

الرسالة : يظهر run-time error 1004

 

ولذلك فقمت في التعديل علي الكود بالتالي

واولا اليك الصورة التي يتم الشرح علي اساسها للجزءين المضافين

 

Qfbnu.jpg

اضافة الجزء التالي علي الكود

وذلك حتي يتم اولا ازاله الحماية من علي الشيتات المحددة في بداية تنفيذ الكود بالجزء التالي

وهي هنا في الشكل السابق اعتبارا من الشيت رقم 2 وحتي آخر شيت

السطر التالي يقوم بامر الكود بالاكمال حتي في حاله وجود خطأ 
On Error Resume Next
السطر التالي يتم وضع متغير اسمه i يكون اعتبارا من الشيت رقم 2 كما في الصورة التاليه 
حتي آخر شيت في الملف ( يقوم بعد الشيتات من 2 الي النهاية )
   For i = 2 To Sheets.Count
ثم نأمر الكود باختيار الشيت i وهو هنا كما قلنا الاختيار من الشيت رقم 2 الي النهاية 
وهو هنا في مثالنا يبدأ بعد الشيت ( عام ) ليشمل الشيتات (الاتوبيس - طائرة - مطروح - تعديل )
      Sheets(i).Select
السطر التالي يقوم بازالة الحماية عن الشيت النشط والذي تم حمايته بالرقم السري 1
والشيت النشط هنا هو الشيت i في كل مرة يقوم الكود باختيار شيت معين من الشيتات i
      ActiveSheet.Unprotect ("1")
انهاء جمله for
 Next i

ثم اعادته الحماية  مرة اخري في نهاية الكود

بالجزء التالي من الكود

On Error Resume Next
    For i = 2 To Sheets.Count
        Sheets(i).Select
      Sheets(i).Select
      ActiveSheet.Protect ("1")
    Next i

وهو نفس شرح الجزء السابق فيما عد الجزء الخاص  ActiveSheet.Protect  حيث يكون  Protect  وليس Unprotect 

لاعادة الحماية علي الشيتات i المحددة في الكود

 

ارجو ان اكون قد وفقت في شرح المعلومة

تقبل خالص تحياتي

  • Like 2
رابط هذا التعليق
شارك

السلام عليكم

الاخ الكريم / ۩◊۩ أبو حنين ۩◊۩

بارك الله فيك

بالنسبة للشرح واين الخطأ ...

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

Range("B5:B40" & ",H5:H40" & ",J5:J40" & ",O5:O40").ClearContents

وفي نفس الوقت تقوم بحماية الشيتات من التعديلات ... فبالتالي عند تنفيذ الكود لعملية المسح .. سيتوقف ... حيث ان الشيت المحدد او الشيتات المحددة

لعمل الكود محمية من التعديل

 

وبالنسبة للكود ( السطر ) المستخدم منكم او من الاخ الفاضل / وليد فتحي

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

وبالتالي تظهر معك الرسالة الخاصة بمسح المحتويات المطلوبة في الشيتات المحددة  .. حيث انه لم يتم ازاله الحماية عنها لتنفيذ الكود ومسح البيانات

 

الرسالة : يظهر run-time error 1004

 

ولذلك فقمت في التعديل علي الكود بالتالي

واولا اليك الصورة التي يتم الشرح علي اساسها للجزءين المضافين

 

Qfbnu.jpg

اضافة الجزء التالي علي الكود

وذلك حتي يتم اولا ازاله الحماية من علي الشيتات المحددة في بداية تنفيذ الكود بالجزء التالي

وهي هنا في الشكل السابق اعتبارا من الشيت رقم 2 وحتي آخر شيت

السطر التالي يقوم بامر الكود بالاكمال حتي في حاله وجود خطأ 
On Error Resume Next
السطر التالي يتم وضع متغير اسمه i يكون اعتبارا من الشيت رقم 2 كما في الصورة التاليه 
حتي آخر شيت في الملف ( يقوم بعد الشيتات من 2 الي النهاية )
   For i = 2 To Sheets.Count
ثم نأمر الكود باختيار الشيت i وهو هنا كما قلنا الاختيار من الشيت رقم 2 الي النهاية 
وهو هنا في مثالنا يبدأ بعد الشيت ( عام ) ليشمل الشيتات (الاتوبيس - طائرة - مطروح - تعديل )
      Sheets(i).Select
السطر التالي يقوم بازالة الحماية عن الشيت النشط والذي تم حمايته بالرقم السري 1
والشيت النشط هنا هو الشيت i في كل مرة يقوم الكود باختيار شيت معين من الشيتات i
      ActiveSheet.Unprotect ("1")
انهاء جمله for
 Next i

ثم اعادته الحماية  مرة اخري في نهاية الكود

بالجزء التالي من الكود

On Error Resume Next
    For i = 2 To Sheets.Count
        Sheets(i).Select
      Sheets(i).Select
      ActiveSheet.Protect ("1")
    Next i

وهو نفس شرح الجزء السابق فيما عد الجزء الخاص  ActiveSheet.Protect  حيث يكون  Protect  وليس Unprotect 

لاعادة الحماية علي الشيتات i المحددة في الكود

 

ارجو ان اكون قد وفقت في شرح المعلومة

تقبل خالص تحياتي

 

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

بالفعل وفقت في شرح المعلومة شرح وافي وكافي

جزاك الله كل خير وجعله في ميزان حسناتك

تقبل مروري

رابط هذا التعليق
شارك

اخى العزيز حمادة عمر

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

 

رابط هذا التعليق
شارك

السلام عليكم

الاخ الكريم / ۩◊۩ أبو حنين ۩◊۩

بارك الله فيك

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

ولكن قم بازاله الحماية عليه ولن يتأثر بالكود فيما بعد

فالكود لا يخصه حيث انه الشيت رقم 1 وفي الكود كما قلنا يبدأ الحماية وفك الحماية من الشيت رقم 2 كما في السطر التالي من الكود

 For i = 2 To Sheets.Count

واليك الملف مرة اخري بدون حماية شيت عام

وفي انتظار ردك

تقبل خالص تحياتي

 

تنفيذ كود مسح بيانات من شيتات مع حماية هذه الشيتات+.rar

رابط هذا التعليق
شارك

  • 4 weeks later...

السلام عليكم اخى الحبيب  حماده عمر

بغد التحيه

اخى الحبيب

اريد تنفيد هذا الكود مع وجود حمايه ايضا للشيت

هذا الكود يقوم باخفاء الصفوف التى محتوى الهليه d بها صفر

وهذا الشيت محمة بكله سر 2191612

 

 

Sub dahmour()
If ActiveSheet.FilterMode = True Then
    On Error Resume Next
ActiveSheet.ShowAllData
Else
Range("D4:B" & Cells(Rows.Count, "B").End(xlUp).Row).AutoFilter field:=1, Criteria1:="<>0", visibleDropDown:=False
End If
End Sub

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

رابط هذا التعليق
شارك

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