حماية خلايا بكود ماكرو فيزيال بازيك

[زاكي بوشلاغم]

السلام عليكم عندي ملف ايكسل اريد. حماية بعض الخلايا بكود فيزيال بازيك كيف يتم ذلك  

شكل كود macro visual basic

Private Sub Worksheet_SelectionChange(ByVal Tr As Excel.Range)
Set Rng = Range("e10,f10,g10,h10,i10")
If Not Intersect(Tr, Rng) Is Nothing Then
   Tr.Offset(0, 1).Select
   Set Rng = Nothing
End If
End Sub

[عبدللرحيم]

تفضل من عباقرة المنتدى

لعله ما طلبت إن شاء الله 

 

 

 

[زاكي بوشلاغم]

اخي لم تصلح معي اريد كود visual basic macro اي صنع ماكرو يقوم بحماية الخلايا المراد حمايتها مثل ماكرو المقدم لكم في الاعلى كيف اصنع ماكرو في ورقة ايكسل الخاصة بي

[عبدللرحيم]

اخى زاكى

الكود داخل الملف

إذا تمت الكتابة على خلية لا يتم التعديل عليها 

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim X As Range
    For Each X In Target
        '  600 åæ ÇÎÑ ÓØÑ áÚãá ÇáßæÏ
        'L  åæ ÇáÚÇãæÏ  column 12
        If (X.Row < 600 And X.Column < 12) Then
            

            If ActiveSheet.ProtectContents = True And X.Value <> "" Then X.Offset(0, 1).Select
        End If
    Next
End Sub

 

[زاكي بوشلاغم]

اين الملف

[زاكي بوشلاغم]

السلام عليكم اريد  خلق ماكرو  حمابة الخلايا  كبف يتم ذلك 

[عبدللرحيم]

اخى زاكى

الكود  داخل الملق 

عدم التعديل فى اسطر محددة (1).xlsb

[زاكي بوشلاغم]

اريد كود الحماية الخلايا 

من e10   الى I10

من e13   الى I13

من e20   الى I20

من e27   الى I27

من e33   الى I33

من e46   الى I46

من e56   الى I56

من e59   الى I59

من e62   الى I62

من e68   الى I68

من e68   الى I68

 

 

 

 

 

 

 

 

حيث كود الحماية يكون هذا

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim protectedRange As Range
    Set protectedRange = Range("A2:K2") هنا ادراج جميع الحلايا المراد حمايتها لم اعرف كيف ادخلها من E13.الئ I13 ................
    If Not Intersect(Target, protectedRange) Is Nothing Then
        Application.EnableEvents = False
        Application.Undo
        MsgBox "لا يمكن تعديل هذه الخلية، يرجى فك حماية الورقة للقيام بذلك"
        Application.EnableEvents = True
    End If
End Sub

[عبدالله بشير عبدالله]

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

بعد اذن استاذنا الفاضل عبدللرحيم 

4 ساعات مضت, زاكي بوشلاغم said:

Set protectedRange = Range("A2:K2") هنا ادراج جميع الحلايا المراد حمايتها لم اعرف كيف ادخلها من E13.الئ I13 ................

طريقة ادخال النطاقات للكود

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim protectedRange As Range
    
    Set protectedRange = Union( _
        Range("E10:I10"), _
        Range("E13:I13"), _
        Range("E20:I20"), _
        Range("E27:I27"), _
        Range("E33:I33"), _
        Range("E46:I46"), _
        Range("E56:I56"), _
        Range("E59:I59"), _
        Range("E62:I62"), _
        Range("E68:I68") _
    )
    
    If Not Intersect(Target, protectedRange) Is Nothing Then
        Application.EnableEvents = False
        Application.Undo
        MsgBox "لا يمكن تعديل هذه الخلية، يرجى فك حماية الورقة للقيام بذلك"
        Application.EnableEvents = True
    End If
End Sub

 

[زاكي بوشلاغم]

شكرا اخي لكن عندما ادخل كود ماكرو في الملف واغلق الملف وعند فتح الملف لا يعمل ما الحل اخي 

تم تعديل منذ 2 ساعات بواسطه زاكي بوشلاغم

[عبدالله بشير عبدالله]

الاسباب كثيرة منها عدم تفعيل او تمكين المحتوى او لم يتم حفظ الملف بصيغة XLSM-XLSB 

ارفاقك للملف يختصر الوقت  ويحدد ما السبب

[زاكي بوشلاغم]

السلام عليكم اخي هذا الملف نرجو منكم حماية  الخلايا في ورقة   :ادخال نفقات 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim protectedRange As Range
    
    Set protectedRange = Union( _
        Range("E10:I10"), _
        Range("E13:I13"), _
        Range("E20:I20"), _
        Range("E27:I27"), _
        Range("E33:I33"), _
        Range("E46:I46"), _
        Range("E56:I56"), _
        Range("E62:I62"), _
        Range("E68:I68") _
         Range("E74:I74") _ 
    )
    
    If Not Intersect(Target, protectedRange) Is Nothing Then



كمال نرجو منكم الشرح كيفية حفظ الملف لكي يكون الماكرو فعال وشكرا 
        Application.EnableEvents = False
        Application.Undo
        MsgBox "لا يمكن تعديل هذه الخلية، يرجى فك حماية الورقة للقيام بذلك"
        Application.EnableEvents = True
    End If
End Sub

casse 2026 .xlsx

[عبدالله بشير عبدالله]

صيغة الملف XLSX  وهذه الصيغة لا تحتفظ بالكود بل تحذفه 

في اي شيت تريد اظافة الكود

[زاكي بوشلاغم]

ممكن تشرح كيفية حفظ ملف ماكرو بارك الله فيك 

 

[عبدالله بشير عبدالله]

طريقة حفظ الملف

بعد وضع الكود في الملف قم باغلاق الملف ستاتى رسالة كما بالصورة  اخت

 

اختر حفظ  ستاتى رسالة اخرى كما بالصورة 

 

 

 اختر لا ستفتح واجهة كما بالصورة  

قم بالاختيار حسب الصف المحدد  ثم حفظ

casse 2026 .xlsb

تم تعديل منذ 1 ساعه بواسطه عبدالله بشير عبدالله

[زاكي بوشلاغم]

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