خطأ فى كود حماية

[الشاب يوسف]

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

مثال.rar

تم تعديل ديسمبر 25, 2012 بواسطه yousifsamra

[الشاب يوسف]

ارجو من الإخوه مساعدتى فى ضبط هذا الكود لانى منذ ساعات وأنا احاول ضبطه بلا جدوى واسف على تكرار الطلب

[الـعيدروس]

ما المطلوب من الكود أن يفعل ؟

[الـعيدروس]

السلام عليكم

Public ws As Worksheet

Private Const Pas As String = "123" ' الباسورد للحماية

Sub ProtectAllSheets()

    For Each ws In Worksheets

	    ws.Protect Password:=Pas

    Next ws

End Sub

Sub UnProtectAllSheets()

    For Each ws In Worksheets

	    ws.Unprotect Password:=Pas

    Next ws

End Sub

تم تعديل ديسمبر 25, 2012 بواسطه عباد

[الشاب يوسف]

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

تم تعديل ديسمبر 25, 2012 بواسطه yousifsamra

[الـعيدروس]

ادخلت رقم سري خاطئ

تأكد من حالة الأحرف إن كان به حروف

رغم إن التعديل يعمل ماطلبت يحمي جميع الاوراق ويغلي الحماية

إن كنت تريد صندوق إدخال للرقم السري بدل من الولوج الى محرر الاكواد

Public ws As Worksheet

Sub ProtectAllSheets()

Dim Pas As Integer

Pas = InputBox("ادخل الرقم السري", "رمز الحماية")

If Pas = False Or Pas = Cancel Then Exit Sub

For Each ws In Worksheets

	 ws.Protect Password:=Pas

Next ws

End Sub

Sub UnProtectAllSheets()

Dim Pas As Integer

Pas = InputBox("ادخل الرقم السري", "إلغاء الحماية")

If Pas = False Or Pas = Cancel Then Exit Sub

	 For Each ws In Worksheets

	 On Error GoTo 0:

		 ws.Unprotect Password:=Pas

	 Next ws

Exit Sub

0:

MsgBox "كلمة المرور خطاء تأكد من حالة الأحرف", vbExclamation, "تنبية !!!"

End Sub

تم تعديل ديسمبر 25, 2012 بواسطه عباد

[الشاب يوسف]

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

حماية جميع الصفحات.rar

[الـعيدروس]

جربت الكود يعمل بكفائة أين المشكلة ؟؟؟

[الشاب يوسف]

الكود لا يغلق جميع الصفحات ولكنه يغلق صفحه واحده فقط والمطلوب انه يغلق جميع الصفحات مره واحده

[الـعيدروس]

السلام عليكم

تفضل

Dim x As Variant

Dim Sh As Worksheet

Sub pro_unpro()

On Error Resume Next

Dim XX As Shape

Set XX = ActiveSheet.Shapes("Button 18")

With XX.TextFrame.Characters

    If .Text = "حماية" Then

	   .Text = "فك الحماية"

	   protectAll

    Else

	  unprotectAll

	   .Text = "حماية"

    End If

End With

On Error GoTo 0

End Sub

Sub protectAll()

x = Application.Dialogs(28).Show

If x = True Then

For Each Sh In ThisWorkbook.Worksheets

Sh.Protect Password:=x

Next

End If

End Sub

Sub unprotectAll()

x = Application.Dialogs(28).Show

If x = True Then

For Each Sh In ThisWorkbook.Worksheets

Sh.Unprotect Password:=x

Next

End If

End Sub

[ياسر خليل أبو البراء]

الأخ الغالي أبو نصار

الكود يقوم بعمل حماية على ورقة عمل واحدة فقط وليس على كل أوراق العمل

رغم أن الكود لا يوحي بذلك

[الشاب يوسف]

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

[الشاب يوسف]

الأخوه الأعزاء الا توجد طريقه لضبط هذا الكود أو تغييره ولكن مع المحافظه على الحماية عن طريق ( Application.Dialogs(28 ويحقق المطلوب وهو حماية جميع الصفحات ولكم جزيل الشكر والتحية

تم تعديل ديسمبر 28, 2012 بواسطه yousifsamra

[الشاب يوسف]

up

[الـعيدروس]

ماالفرق بين استخدام ( Application.Dialogs(28

و صندوق إدخال

بإمكانك إستخدام صندوق إدخال ويعمل بكفائة ؟؟؟

[ضاحي الغريب]

السلام عليكم

تفضل

Dim x As Variant

Dim Sh As Worksheet

Sub pro_unpro()

On Error Resume Next

Dim XX As Shape

Set XX = ActiveSheet.Shapes("Button 18")

With XX.TextFrame.Characters

If .Text = "حماية" Then

	 .Text = "فك الحماية"

	 protectAll

Else

	 unprotectAll

	 .Text = "حماية"

End If

End With

On Error GoTo 0

End Sub

Sub protectAll()

x = Application.Dialogs(28).Show

If x = True Then

For Each Sh In ThisWorkbook.Worksheets

Sh.Protect Password:=x

Next

End If

End Sub

Sub unprotectAll()

x = Application.Dialogs(28).Show

If x = True Then

For Each Sh In ThisWorkbook.Worksheets

Sh.Unprotect Password:=x

Next

End If

End Sub

أخي العزيز أبو نصار مايسترو الاكواد

والله اعمالك كلها جميلة وافكارها سلسلة

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

بارك الله لك

تقبل تحياتي