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

[محمد عبد الناصر]

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

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

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

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

 

تم تعديل مارس 20, 2023 بواسطه محمد عبد الناصر

[lionheart]

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

 

[محمد عبد الناصر]

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

 

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