حماية / عدم حماية أوراق العمل بأى عدد من الملفات داخل مجلد

[مختار حسين محمود]

بسم الله الرحمن الرحيم


والصلاة والسلام على أول الأنبياء وخاتم المرسلين سيدنا محمد ( صلى الله عليه وسلم  ) صلاةً الى يوم الدين

إخوانى وأحبابى وزملائى  وأساتذتى فى منتدانا العريق السلام عليكم ورحمة الله وبركاته
 
أما بعد

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

 

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

 

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

 

لكم منى كل محبة وتقدير واحترام
 
والحمد لله تعالى من قبل ومن بعد

***************

تفضلوا المرفق   وعليه       

Protect Unprotect All Files In A Folder.rar

[عبد العزيز البسكري]

بارك الله فيك و جزاك الله خيرًا .. و زادها في ميزان حسناتك ..أستاذنا .. يا مختار يا حسين يا محمود

[مختار حسين محمود]

بارك الله فيك يا أخى عبدالعزيز

 

     

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

بسم الله ما شاء الله

بارك الله فيك وجزاك الله خير الجزاء

بصراحة هو دا الشغل يا بلاش .. كدا إنت سمعت الكلام وكدا إنت حبيبي

تقبل تحياتي

[ابراهيم الحداد]

بسم الله  . ماا شاء الله . ابداع لايتوقف سلمت يداك

[Yasser Fathi Albanna]

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

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

[أبو إيمان]

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

أستاذ / ياسر خليل    الرجل حبيبنا من غير حاجة مش لازم مصلحة علشان يكون حبيبك

 

لكن أستاذ / مختار  محتاجين شرح الكود بالعربي    ( علشان تبقى حبيبي أنا كمان " ههههه " )

[ابو القبطان]

اتمنى ان ابارك لك قريباً تغيير العضو والنجمة

فأعمالك تشهد لك

[مختار حسين محمود]

أستاذى الفاضل ياسر خليل
أستاذى الفاضل زيزو
أستاذى الفاضل ياسر فتحى
أستاذى الفاضل أبو ايمان  
أستاذى الفاضل أبو القبطان

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

فأنا شخصيا  أستفيد  قبلكم

 

وأنا أحبكم جميعاً فى الله

وأسعد  - والله العظيم  - بمروركم على كتاباتى

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

 

تحياتى لكم جميعا

 

[مختار حسين محمود]

شرح الكود بالعربى قدر الامكان عشان ما يزعلش حبيبى أبو ايمان    

Option Explicit

Sub SetProtectionInAllSheetsAllFilesInFolder()
'Jerry Beaucaire 3/4/2010 - اسم صاحب الكود
' اخنر مجلد تم احمى كل ملفات الاكسل بباسورد
'  تأثير الكود يكون على أوارق العمل أو بنية الملف
' السطور الثلاث التالية توضح التصريحاتالتى سنعلن عنها
Dim fPath As String, fName As String
Dim pwd As String, pwd2 As String, ws As Worksheet, wb As Workbook
Dim Ans As Long, Ans2 As Long, Cnt As Long

'اختيار مجلد من المربع الحوارى
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then fPath = .SelectedItems(1) & "\" Else Exit Sub
    End With
    
'السطور التالية توضح عملية الاختيار بين الحماية أو فك الحماية
    Ans = Application.InputBox("هل تريد حماية أو عدم حماية الملفات فى هذا المجلد ؟" & vbLf & vbLf & _
        "Enter 1 - حماية الملفات" & vbLf & "Enter 2 - عدم حماية الملفات" & vbLf & vbLf & _
        " سوف يتم تجاهل الأمر  CANCEL  أى قيمة أخرى أو", " حماية أو عدم حماية ؟", Type:=1)
    If Ans < 1 Or Ans > 2 Then Exit Sub
    
'السطور التالية توضح عملية الاختيار بين الحماية أو فك الحماية من أوراق العمل أو بنية الملف
    Ans2 = Application.InputBox("هل تريد حماية أو عدم حماية أوراق العمل فى أى ملف أم البنية ؟ " & vbLf & vbLf & _
        "Enter 1 -   أوراق العمل فقط" & vbLf & "Enter 2 - التأثير فى البنية فقط" & vbLf & "Enter 3 - التأثير فى أوراق العمل والبنية معاً" & vbLf & vbLf & _
        "سوف يتم تجاهل الأمر  CANCEL  أى قيمة أخرى أو", "أوراق العمل أم البنية", Type:=1)
    If Ans2 < 1 Or Ans2 > 3 Then Exit Sub
    
'السطور التالية للحصول على  باسورد لإتمام عملية الحماية أو فك الحماية
    Do
        pwd = Application.InputBox(" : كلمة السر المستخدمة التى سوف تستخدم", "Enter Password", Type:=2)
        If pwd = "False" Then Exit Sub
        pwd2 = Application.InputBox("رجاءً أدخل كلمة السر مرةً أخرى للتأكيد ", "Re-Enter Password", Type:=2)
        If pwd2 = "False" Then Exit Sub
        If pwd = pwd2 Then Exit Do Else MsgBox "كلمة السر خاطئة, حاول مرةً أخرى"
    Loop
' السطور التالية لتلافى رسائل الأخطاء
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    fName = Dir(fPath & "*.xls*")               'الحصول على اسم أول ملف اكسل

'عملية حماية الملف
    Do While Len(fName) > 0
        Set wb = Workbooks.Open(fPath & fName)  'فتح باقى الملفات الموجودة بالمجلد
        If Ans2 = 1 Or Ans2 = 3 Then                         'معالجة  أوراق العمل
            For Each ws In wb.Worksheets
                If Ans = 1 Then ws.Protect Password:=pwd Else ws.Unprotect Password:=pwd
            Next ws
        End If
        If Ans2 = 2 Or Ans2 = 3 Then
            If Ans = 1 Then
                wb.Protect Password:=pwd, Structure:=True, Windows:=False
            Else
                wb.Unprotect Password:=pwd
            End If
        End If
        wb.Save ة                                'حفظ  الملف بعد انهاء عملية الحماية أو فك الحماي
        wb.Close                                'اغلاق الملف بعد انهاء عملية الحماية أو فك الحماية
        Cnt = Cnt + 1                           'تطبيق العملية السابقة على كل ملفات الاكسل الموجودة بداخل المجلد
        fName = Dir
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    MsgBox "الاجمالى " & Cnt & " ملفات تمّ معالجتها"
End Sub




          
 

 

              مع 
 

تم تعديل مارس 23, 2015 بواسطه مختار حسين محمود

[سـامي 169]

جزيل الشكر لك ... بارك الله فيك ...

[محي الدين ابو البشر]

كلام جميل بل رائع في الجقيقة

كنت ابحث عم كود لحماية الخلايا التي تحوي معادلات واعتقد انه يمكنني البدء  من هذا الكود

هل هذا ممكن؟

بار ك الله بجهودك  وفي ميزان حسناتك بإذن الله

[مختار حسين محمود]

أخى الفاضل سامى
أستاذى الفاضل محمدين

بارك الله فيكما وشرفتما الموضوع .

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

  فلا نستطيع الحذف أو الاضافة الا بعد فك الحماية

 

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

ابحث عنها اذا رغبت 

تحياتى

[محي الدين ابو البشر]

شكرا لك اخ مختار وبارك الله بك

محي الدين!!!

[مختار حسين محمود]

شكرا لك اخ محى الدين وبارك الله بك

 

شرفت بمروركم

تم تعديل مارس 27, 2015 بواسطه مختار حسين محمود