تحويل كود (Private sub) الى ماكرو لتقييد تشغيله بالضغط على زر

[Hisham Abdullah]

السلام عليكم اخواني..

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

ولكن لم يسبق وان تعاملت مع اكواد (VBA)

واليوم حصلت على كود (Private sub) جاهز لتنفيذ أمر لحماية الخلايا بعد الادخال مباشرة

ولكنني ارغب في تقييد هذا الكود ، بحيث لا يقوم بتنفيذ الامر إلا بعد الضغط على زر (حفظ)

سواءاً من خلال تعديله وابقائه (Private) او تحويله الى ماكرو وربطه بزر للتنفيذ ، والكود هو:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range
    On Error Resume Next
    Set xRg = Intersect(Range("A1:F8"), Target)
    If xRg Is Nothing Then Exit Sub
    Target.Worksheet.Unprotect Password:="123"
    xRg.Locked = True
    Target.Worksheet.Protect Password:="123"
End Sub

وشكراً لكم  مقدماً ،،

 

[Ali Mohamed Ali]

وعليكم السلام استاذ هشام-اهلا بك اخ كريم فى المنتدى

تفضل هذ الكود به طلبك -يعمل على حماية الخلايا بعد الحفظ

Public Sub Ziad_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

 

[Hisham Abdullah]

شكراً جزيلاً اخي العزيز ، وتشرفت جداً بانضمامي لأسرة "أوفيسنا" الرائعة..

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

فأولاً/ لابد من تقديم كل عبارات الشكر لشخصك الرائع ..

أما ثانيا / الكود نفذ المطلوب تماماً .. ولكن هنالك اشكاليتين بسيطتين واجهتهما وهما:

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

2- الخلايا "الفارغة المؤمنة" التي في جميع تلك الصفحات يُلغى تأمينها

والآن /

1- هل بالامكان تعديل الكود بحيث يتم حصرة فقط في "Active_sheet" .!

2- ايضاً يتم تقييدة بـ "Range" معين داخل هذا الشيت

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

وشكراً جزيلاً لك مرة أخرى ،،

[Hisham Abdullah]

وهنا اود التنويه الى أن الكود الذي وضعته أنا في الموضوع ..

قام بتنفيذ المطلوب تمااااماً ، وكانت مشكلتي الوحيدة فيه هي :

عدم قدرتي في جعله "Public" ليتم تشغيله بواسطة زر ماكرو

تم تعديل أغسطس 10, 2018 بواسطه Hisham Abdullah

[أبو حنف]

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

Sub save()
    Dim xRg As Range
    On Error Resume Next
    Set xRg = Intersect(Range("A1:F8"), Target)
    If xRg Is Nothing Then Exit Sub
    Target.Worksheet.Unprotect Password:="123"
    xRg.Locked = True
    Target.Worksheet.Protect Password:="123"

End Sub

 

تم تعديل أغسطس 11, 2018 بواسطه أبو حنف