Belirli Hücrelerin, değiştirilmesini ve silinmesini Engelleme

[halit3]

ThisWorkbook daki kodlarıda aşağıdakilerle değiştiriniz.

Dim sayfa As String
Private Sub Workbook_Open()
Sheets("insört").Select
UserForm1.Show
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
user = Environ("username")
If user <> "ergun.guler" Then
If ActiveSheet.Name = "insört-veri" Then
'UserForm1.Show
Sheets(sayfa).Select
MsgBox "Bu Sayfayı Görmeye Yetkiniz Yok!", vbCritical, "Sayın " & user
End If
End If
sayfa = ActiveSheet.Name
End Sub

 

[halit3]

ekli dosyanızı kontrol ediniz.

 

[Ergün Güler]

ekli dosyanızı kontrol ediniz.

Sayın Halit3,
Çok özür dilerim. Şifreyi vermeyi unutmuşum. Ancak siz yine de çözmüşsünüz.

workbook'taki kodlar ile "insört-veri" görüntülenmeden engelleniyor. Tam istediğim gibi olmuş elinize sağlık. Userform1'den de girilmek istendiğinde aynı şey mümkün mü? (Form'daki adı: İnsört Veri Girişleri'dir)

"insörtsorgulama-tekli" sayfasındaki kodlar sağlıklı çalışmıyor.
satır ve sütun silinebiliyor.

Private Sub Worksheet_SelectionChange altında ayrıca başka kodlar çalıştırmak zorundayım. beraber çalıştıramıyorum.

Ayrıca, Asıl dosyamda O sütununda hücrelere tıkladığımda modul1'deki kodlar çalışıyor.

sizin gönderdiğiniz kodlar ile O sütunu kullanamıyorum.

Sizi fazla yormak istemiyorum. Olmazsa sağlık olsun.
Emeğinize sağlık. Gerçekten çok sağolun. Çok şey öğreniyorum sizden.

İyi çalışmalar.

 

[halit3]

bu nu denermisiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
sat = 2
sut = 7
ScrollArea = ""
user = Environ("username")
sifre = "1234"
If user = "ergun.guler" Then
ActiveSheet.Unprotect Password:=sifre
Cells.Locked = False
Exit Sub
ElseIf user <> "ergun.guler" Then
If Not Intersect(Target, Range("A1:G2")) Is Nothing Then: Exit Sub
If sat <> Rows.Count Then sat = sat
If sut <> Columns.Count Then sut = sut
ScrollArea = Range(Cells(1, 1), Cells(sat, sut)).Address
Range("A2").Select
Else
ScrollArea = ""
End If
Dim son As Long
If WorksheetFunction.CountA(Cells) > 0 Then
son = Range("O7:O" & Rows.Count).Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Else
son = 7
End If
If Intersect(Target, Range("O7:O" & son)) Is Nothing Then Exit Sub
a = Target.Row
urt_no = Cells(a, "A")
kolon = 1 ' "A" sütunu Üretim no. olduğu sütun
ilk_st = 6 ' ilk sorgu satırı öncesi satırlar
s_max = son - ilk_st
s_no = a - ilk_st 'başlangıç satırı
UserForm1.Show
dip:
End Sub
Private Sub Worksheet_Activate()
Range("A2").Select
'************ BU SAYFADA Sadece A1:G2 ARALIĞINA VERİ GİRİLEBİLİR***********
user = Environ("username")
sifre = "1234"
ActiveSheet.Unprotect Password:=sifre
Cells.Locked = True
Range("A1:G2").Locked = False
ActiveSheet.Protect Password:=sifre
If user = "ergun.guler" Then
ActiveSheet.Unprotect Password:=sifre
End If

End Sub

 

[Ergün Güler]

Selam,
son gönderdiğiniz kodlar ile "insörtsorgulama-tekli" sayfasındaki O sütunda kullandığım kodlar çalışmadı. O sütunundaki "DETAY"a tıkladığımda Form2 açılacaktı.
18.sıraki dosyamı güncelledim. Asıl dosyamı koydum. Gönderdiğiniz kodları bir de siz denersiniz.
İyi çalışmalar.

 

[ekremkaradeniz]

ekli dosyanızı kontrol ediniz.

bu dosyayı link vererek yüklemeniz mümkün olur mu