Korumalı sayfada makro çalıştırma

[mcetinkaya65]

Üstadlarım;
Aşağıdaki kodları makroların ilk satırından sonra ve son satırından önce yazınca,makro sayfa kilidini açıyor işlemi yapıp sayfayı tekrar koruyor.Sayfa korumasını yaptığında tam korumaya alıyor.Sayfa içinde filtreleme,sıralama gibi bazı şeylere izin vermesi mümkün mü?.

ActiveSheet.Unprotect "123"

ActiveSheet.Protect "123"

 

[Orion1]

Deneyiniz.

 ActiveSheet.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowSorting:=True, AllowFiltering:=True

 

[mcetinkaya65]

Teşekkürler.
Allah razı olsun.

 

[hüseyin551]

selam hocam..
bu konu üzerinden size bir sormak istiyorum.
sizlerin vermiş olduğu makroları kopyala yapıştırdım ama olmadı. saygılarımla.

Private Sub CommandButton1_Click()
Sayfa10.PrintPreview
End Sub

Private Sub CommandButton2_Click()
Sayfa10.PrintOut Copies:=1
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Alan As String
If Intersect(Target, [B9,f9,g9,k9,l9]) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
Cancel = True
If Target.Value <> "" Then

sut = Target.Column + 0
If Cells(1, sut) = "" Then
Cells(1, sut) = Target.Value
Else
If Cells(Rows.Count, sut) = Empty Then
If Not Intersect(Target, [B9]) Is Nothing Then
Alan = "A13:C13"
ElseIf Not Intersect(Target, [F9]) Is Nothing Then
Alan = "D13:I13"
ElseIf Not Intersect(Target, [K9]) Is Nothing Then
Alan = "J13:O13"
End If
If Not Intersect(Target, [B9,F9,K9]) Is Nothing Then
Range(Alan).Insert Shift:=xlDown
Rows("14:14").Copy
Rows("13:13").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Range("C14").Copy Range("C13")
Range("E14").Copy Range("E13")
Range("H14:I14").Copy Range("H13")
Range("M14:O14").Copy Range("M13")
Range("T14:U14").Copy Range("T13")
End If
sat = 12
Cells(sat + 1, sut) = Target.Value
If sut = 2 Then
Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
ElseIf sut = 6 Then
Cells(sat + 1, sut - 2) = Format(Now, "dd.mm.yyyy")
ElseIf sut = 11 Then
Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
End If
Else
MsgBox Choose(sut / 9, "B", "F", "G", "K", "L") & " Sütunu doldu.", vbCritical
End If
End If
Target.Value = ""
Target.Select
End If
Application.EnableEvents = True
End Sub
ActiveSheet.Unprotect "55"
ActiveSheet.Protect "55"

ActiveSheet.Protect Password:="55", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True