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

[احمد محمد ماترك]

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

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

cash (1).rar

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

جرب الكود التالي في حدث المصنف

Private Sub Workbook_Open()
    Dim Sh As Worksheet

    For Each Sh In ThisWorkbook.Worksheets
        Sh.Range("IV1").Value = "True"
    Next Sh
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Sh As Worksheet
    Dim Sn As Worksheet
    Dim Rng As Range

    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        For Each Sn In ThisWorkbook.Worksheets
            If Sn.ProtectContents = True Then Sn.Unprotect Password:="123": Sn.Cells(1, "IV") = "True": Sn.Protect Password:="123"
        Next Sn
    
        For Each Sh In ThisWorkbook.Worksheets
            If Sh.ProtectContents = True Then Sh.Unprotect Password:="123": Sh.Cells.Locked = False
            If Not Sh.Cells.HasFormula Then Sh.Cells.Locked = False Else Sh.Cells.FormulaHidden = True
    
            For Each Rng In Sh.UsedRange
                On Error Resume Next
                If Rng.Value > Empty Or Rng.HasFormula Then Rng.Locked = True
            Next Rng
    
            If Sh.Cells(1, "IV") = "True" Then Sh.Protect Password:="123"
        Next Sh
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

احفظ المصنف ثم أغلقه ثم قم بإعادة فتح وتجربة الحماية

 

[احمد محمد ماترك]

استاذي الغالي استاذ ياسر والله وحشتني مشاركاتك الجميله واسال الله عز وجل ان يجعله في ميزان حسناتك...... استاذنا الغالي انا جربت الكود ولكن تظهر معي نفس المشكله كما في الصوره ياريت لو ملف مرفق يوضح طريقه التطبيق علي اي شيت وشكراا لاهتمامك استاذ  ياسر...

 

[احمد محمد ماترك]

بتظهر كما بالصوره معرفش ليه

تم تعديل يوليو 31, 2016 بواسطه احمد محمد ماترك

[ابو عبدالبارى]

الأخ الكريماحمد محمد ماترك

حل المشكلة انك تضغط على no وتختار نوع من الملفات excel macro-enabled workbook احفظ الملف وافتحه مره اخرى

[احمد محمد ماترك]

شكرا يااستاذ ابوعبدالباري فعلا اتحلت المشكله وشكر استاذنا الغالي استاذ ياسر ... انا جيت اطبق الكود علي شيت حسابات عندي ظهرت هذه المشكله ارجو الحل

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

يوجد كودين في حدث فتح المصنف بنفس الاسم

قم بدمج الأكواد ..أو ارفع الملف ليستطيع الأخوة تقديم المساعدة إن شاء الله

[احمد محمد ماترك]

شكرا استاذنا الغالي استاذ ياسر طيب ازاي ادمج الاكواد؟؟؟؟ والملف ده مساحته 72ميجا فصعب رفعه وانا جربت اشيل الكود المتشابه ده ظهرت الرساله ديه

تم تعديل أغسطس 1, 2016 بواسطه احمد محمد ماترك

[احمد محمد ماترك]

لقد تم حل المشكله بعد العديد من المحاولات وده الكود الي استخدمته لتلاشي التكرار وشكراا استاذي الغالي استاذ ياسر ...

 

Public Sub Ali_Prodc()
Dim Sh As Worksheet
Dim Rng As Range
Ch_P
On Error Resume Next
With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
  .EnableEvents = False
For Each Sh In ThisWorkbook.Worksheets
If Sh.ProtectContents = True Then Sh.Unprotect Password:="123": Sh.Cells.Locked = False
If Not Sh.Cells.HasFormula Then Sh.Cells.Locked = False Else Sh.Cells.FormulaHidden = True
With Sh.Cells
  .SpecialCells(2).Locked = True
  .SpecialCells(-4123).Locked = True
End With
If Sh.Cells(1, "IV") = "True" Then Sh.Protect Password:="123"
Next
  .EnableEvents = True
  .Calculation = xlCalculationAutomatic
  .ScreenUpdating = True
End With
End Sub
Private Sub Ch_P()
Dim Sn As Worksheet
For Each Sn In ThisWorkbook.Worksheets
If Sn.ProtectContents = True Then Sn.Unprotect Password:="123": Sn.Cells(1, "IV") = "True": Sn.Protect Password:="123"
Next
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call Ali_Prodc
End Sub
Private Sub Workbook_Open()

 STARTUP.Show
 START1.Show

 

End Sub

 

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

الحمد لله أنك توصلت للحل  ..

يرجى وضع الأكواد بين أقواس الكود ليظهر بشكل منضبط

تقبل تحياتي

[احمد محمد ماترك]

Public Sub Ali_Prodc()
Dim Sh As Worksheet
Dim Rng As Range
Ch_P
On Error Resume Next
With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
  .EnableEvents = False
For Each Sh In ThisWorkbook.Worksheets
If Sh.ProtectContents = True Then Sh.Unprotect Password:="123": Sh.Cells.Locked = False
If Not Sh.Cells.HasFormula Then Sh.Cells.Locked = False Else Sh.Cells.FormulaHidden = True
With Sh.Cells
  .SpecialCells(2).Locked = True
  .SpecialCells(-4123).Locked = True
End With
If Sh.Cells(1, "IV") = "True" Then Sh.Protect Password:="123"
Next
  .EnableEvents = True
  .Calculation = xlCalculationAutomatic
  .ScreenUpdating = True
End With
End Sub
Private Sub Ch_P()
Dim Sn As Worksheet
For Each Sn In ThisWorkbook.Worksheets
If Sn.ProtectContents = True Then Sn.Unprotect Password:="123": Sn.Cells(1, "IV") = "True": Sn.Protect Password:="123"
Next
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call Ali_Prodc
End Sub
Private Sub Workbook_Open()

 STARTUP.Show
 START1.Show



End Sub