Korumalı sayfada listeye yeni satır ekleme

[ex48]

Ekteki dosyamda sayfaya koruma koyduğumuzda (şifresi 1234) yeni kişi ekleyemiyorum...kullanılan listenin yeni kişi yazılacak satırı göstermesi ve kişinin adı soyadı yazıldıktan sonra tekrar korumaya geçmesi sağlanabilirmi? Ayrıca toplamlar kısmında 1.-2.-3.-telef toplamları formülünün yeni eklenecek satıra otomatik uyarlanması olabilirmi?
Yardımınızı bekliyorum...

 

[Ferhat Pazarçevirdi]

Kodunuzu aşağıdaki gibi değiştirin

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
sat = Target.Row
sut = Target.Column
adrs = Target.Address
adrss = Target.Offset(1 - sat, 0).Address
adr = "$A$" & sat & ":" & adrs & "," & adrss & ":" & adrs
Range(adr).Select
Range(adrs).Activate
st = Cells(6, 1).End(xlDown).Row
If Intersect(Target, Range("A7:AA" & st + 1)) Is Nothing Then: GoTo f1
If Cells(Target.Row, 1) = "Toplam" Then: GoTo f1
ActiveSheet.Unprotect "1234": Exit Sub
f1:
ActiveSheet.Protect "1234"
End Sub

 

[ex48]

Sayın Fpc
Yardımınız için çok teşekkür ederim, gayet güzel çalışıyor. Yalnız x,y,z,aa sütunlarındaki toplama formüllerini (liste içerisindeki) korumaya almıyor bunu düzeltebilirmisiniz.Affınıza sığınarak birde yeni eklenen satırında diğerleri gibi kenar çizgileri çizili olarak oluşması sağlanabilirmi.

 

[Ferhat Pazarçevirdi]

Ekteki dosyayı inceleyiniz.

 

[ex48]

Ekteki dosyayı inceleyiniz.

Sağolun... Bu dosyada ise otomatik toplam satırını korumaya almamış... Gösterdiğiniz ilgiye teşekkür ederim

 

[ex48]

Ekteki dosyayı inceleyiniz.

yukarıdaki dosyada herşey tamam, fakat otomatik toplam satırınıda korumaya dahil edebilecek arkadaşların yardımını bekliyorum...

 

[Ferhat Pazarçevirdi]

Kodları şu şekilde değiştirin

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
sat = Target.Row
sut = Target.Column
adrs = Target.Address
adrss = Target.Offset(1 - sat, 0).Address
adr = "$A$" & sat & ":" & adrs & "," & adrss & ":" & adrs
Range(adr).Select
Range(adrs).Activate
[COLOR=green]'========================================================
[/COLOR]Set bul = Columns(1).Cells.Find(What:="Toplam", LookIn:=xlFormulas, LookAt:=xlWhole)
satir = bul.Row
If Target.Row = bul.Row Then: GoTo f1
If Not Intersect(Target, Range("A7:W" & satir - 1)) Is Nothing Then
   ActiveSheet.Unprotect "1234": Set bul = Nothing: Exit Sub
End If
f1:
ActiveSheet.Protect "1234"
Set bul = Nothing
[COLOR=green]'========================================================
[/COLOR]End Sub

 

[ex48]

Tamamdır... Sağolun.

 

[baydeniro]

Paylaşım için teşekkürler.

 

[hakpin]

Sayın EX 48,
Sayfanızı tesadüf açtım, Makro etkin değilse uyarı veriyor.Bunu nasıl yaptığınızı buradan yazarsanız sevinirim. Saygılarımla