اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

فتح حماية الشيتات وقفل حماية الشيتات بباسورد


إذهب إلى أفضل إجابة Solved by lionheart,

الردود الموصى بها

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

مطلوب تعديل في هذا الكود 

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

Sub go_mod5alat()

If Sheets("ÇáãÏÎáÇÊ").Range("c6") = "" Then MsgBox "ÏÎá ÇÓÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜã ÇáÚãããããíííííííííííííííííííááááááá", vbExclamation: Exit Sub
Sheets("ÝÇÊæÑÉ ãÏÎáÇÊ").PrintOut
Dim ws As Worksheet, Data As Worksheet, ShName As String
Dim LR As Long, ER As Long, x As Integer
Set Data = Sheets("ÇáãÏÎáÇÊ")
ShName = Data.Range("C6").Text

ER = Data.Range("B" & Rows.Count).End(3).Row
x = ER - 7
For Each ws In Worksheets
If ws.Name = ShName Then
LR = ws.Range("B" & Rows.Count).End(3).Row
ws.Name = ShName
ws.Range("B" & LR + 1).Resize(x, 17) = Data.Range("B10").Resize(x, 17).Value

End If
Next
Sheets("ÇáãÏÎáÇÊ").Protect Password:="20125907275"


Sheets("sheet1").Unprotect Password:="20125907275"
Dim strName As String, sh As Worksheet
    
    strName = Trim(Sheet4.Range("am14").Value)
    
    For Each sh In Worksheets
        If sh.Name = strName Then Exit Sub
    Next sh
    Sheet4.Copy after:=Sheets(Sheets.Count)
    Sheets("sheet1 (2)").Name = strName
    With Sheets(strName)
        .Shapes("Button 1").Delete
        With .Range("b10:am10000")
        .Value = .Value
       End With
       
    
 
Sheets("ÇáãÏÎáÇÊ").Range("B10:B1000").ClearContents
Sheets("ÇáãÏÎáÇÊ").Range("d10:d1000").ClearContents
Sheets("ÇáãÏÎáÇÊ").Range("h10:h1000").ClearContents
Sheets("ÇáãÏÎáÇÊ").Range("n10:n1000").ClearContents
Sheets("ÇáãÏÎáÇÊ").Range("c6").ClearContents
Sheets("ÇáãÏÎáÇÊ").Protect Password:="20125907275"
Sheets("ÇáãÏÎáÇÊ").Select
    Range("A1").Select

    ActiveWorkbook.Save
End Sub

 

تم تعديل بواسطه محمد عبد الناصر
رابط هذا التعليق
شارك

  • أفضل إجابة
Sub Test()
    ProtectWorksheets False
        Rem YOUR CODE
    ProtectWorksheets True
End Sub

Public Sub ProtectWorksheets(ByVal bProtect As Boolean)
    Const MYPASS As String = "123"
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If bProtect = False Then
            ws.UnProtect Password:=MYPASS
        Else
            ws.Protect Password:=MYPASS
        End If
    Next ws
End Sub

 

  • Like 3
رابط هذا التعليق
شارك

20 دقائق مضت, lionheart said:
Sub Test()
    ProtectWorksheets False
        Rem YOUR CODE
    ProtectWorksheets True
End Sub

Public Sub ProtectWorksheets(ByVal bProtect As Boolean)
    Const MYPASS As String = "123"
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If bProtect = False Then
            ws.UnProtect Password:=MYPASS
        Else
            ws.Protect Password:=MYPASS
        End If
    Next ws
End Sub

 

شكرا اخي الكريم جعله الله في موازين حسناتك

  • Like 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information