Farklı Kullanıcılara Erişilemez Mesajı

[Ergün Güler]

Selam,
Ortak kullanılan bir excel dosyam var. hücreleri kilitliyorum. Kendi tanımladığım kişiler haricindekilere farklı PC kullanıcı hücre ile işlem yapmak istediğinde kullanıcının adına özel Makro ile bir uyarı yapmak istiyorum.
(Tabiki bu hücre kilitleme veya benzeri şeylerde olabilir. Birçok farklı yerlerde kullanılabilecek şekilde de olabilir)


mesela, dosyayı "ergun.guler" ve "e.maraz" adlı PC kullanıcıları değiştirebilsin.
bunun haricinde değiştirmek isteyen olursa kendi adıyla bir uyarı versin.

mesela "Sayın a.deneme yetkiniz yok" gibi
Yardımcı olabilirseniz sevinirim.

 

[Ergün Güler]

Selam, Herhangi bir fikri olan var mı?
İyi çalışmalar.

 

[Ergün Güler]

Selam Arkadaşlar,
Yardımcı olabilir misiniz?
İyi çalışmalar.

 

[Mehmet Şahin]

Merhaba,
sayfanın workbook kodlarına aşağıdakilerini yapıştırıp deneyin

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 If Me.ReadOnly = True Then
Application.DisplayAlerts = False
If SaveAsUI Then Cancel = True
Application.DisplayAlerts = True
End If
End Sub
Private Sub Workbook_Open()
User = Environ("Username")
On Error GoTo son:
    If User <> "ERGUN" Then
     ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
     MsgBox "Ergün'den başkası değişiklik yapamaz!"
    Else
    ThisWorkbook.ChangeFileAccess Mode:=xlReadWrite
    End If
son:
End Sub

"ERGUN" login adınızdır. Başka bilgisayardan açılınca aktif olur ve dosyada değişiklik yapılamaz. Kendi bilgisayarınızdan açlırsa değişiklik yapılabilir. Kolay gelsin.

 

[Excelmy]

Alternatif olsun,

ThisWorkbook bölümüne

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
sifre = InputBox("Kayıt için şifreyi girmelisiniz", "KAYIT", "şifre girin")
If sifre = "xxx" Then
MsgBox "Kayıt işlemi tamamlandı", vbInformation, _
"KAYIT BAŞARILI"
Else
MsgBox "Yanlış şifre girdiniz." & Chr(13) & "Dosya kaydedilemedi", vbCritical, "HATALI ŞİFRE"
Cancel = True
End If
End Sub

 

[Ergün Güler]

Selam Sayın Dentex,
Yardımlarınız için çok teşekkür ederim. kodlarınız çok güzel olmuş ancak değişiklik yapılabiliyor .Sadece çıkarken uyarıyor. bir de değişiklik sonrası asıl dosyanın kopyası alınabiliyor.
1.mesajımda sorumu tam anlatamamış olabilirim. sorumu aşağıdaki kod ile anlatayım:

A1:G2 haricindeki aralıklara girilmek istendiğinde kullanıcı "ergun.guler" değilse "yetkiniz yok" diyor.
Ancak,ayrıca şunu yapmak istiyorum; yetkisi olmayanlar için
hücre içeriği silinmesin,değiştirilmesin, eklenip kesilmesin.
satır,sütun silinmesin,kesilip eklenmesin.

Private Sub Worksheet_Change(ByVal Target As Range)
user = Environ("username")
If Intersect(Target, Range("A1:G2")) Is Nothing And user <> "ergun.guler" Then
MsgBox "Yetkiniz yok!", vbCritical, "Sayın " & user
End If
End Sub

İyi çalışmalar.

 

[Ergün Güler]

Alternatif olsun,

ThisWorkbook bölümüne

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
sifre = InputBox("Kayıt için şifreyi girmelisiniz", "KAYIT", "şifre girin")
If sifre = "xxx" Then
MsgBox "Kayıt işlemi tamamlandı", vbInformation, _
"KAYIT BAŞARILI"
Else
MsgBox "Yanlış şifre girdiniz." & Chr(13) & "Dosya kaydedilemedi", vbCritical, "HATALI ŞİFRE"
Cancel = True
End If
End Sub

Selam Sayın Kuman,
çok teşekkür ederim. Güzel bir örnek çalışma olmuş. Ancak istediğim bu değildi. Bir önceki mesajımda sorunumu anlattım. Bir bakabilirseniz sevinirim.
İyi çalışmalar.

 

[Ergün Güler]

Sayın Dentex ve Sayın Kuman,
6.sıradaki sorumu güncelledim. Yardımcı olabilirseniz çok sevinirim.
İyi çalışmalar.

 

[Ergün Güler]

Selam,
Sayın Dentex ve Sayın Halit3 verdiğim örnek kodlar sayesinde aşağıdaki kodlar ile istediğim gibi çözüm buldum.

Private Sub Worksheet_Activate()
user = Environ("username")
sifre = "1234"

If user = "ergun.guler" Then
    ActiveSheet.Unprotect Password:=sifre
    Cells.Locked = False

Else

    ActiveSheet.Unprotect Password:=sifre
    
    Cells.Locked = True
    Range("A1:G2").Locked = False
    ActiveSheet.EnableSelection = xlNoRestrictions
    
   ActiveSheet.Protect Password:=sifre, DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowSorting:=True, AllowFiltering:=True

End If
    
End Sub

YUkarıdaki kodlar ile ilgili bir kaç sorum olacak;

1-)

Kod:

Else

    ActiveSheet.Unprotect Password:=sifre

Else'den sonraki kırmızı alanı yazmaz isem, "ergun.guler" değilseniz, dosya 2.kez aktif olunca hata veriyor. Sebebini anlayamadım. Ancak, bu şekilde çözebildim. Sebebi nedir.?

2-)
"ergun.guler" değilseniz kilitli hücrelere müdahalede, excel kendi uyarısını veriyor. Bunun yerine kendimiz bir uyarı verdirebilir miyiz?

3-) sayfa koruma kaldırması "1234"'dür. "ergun.guler" olmayan kişiler "1234" girince sayfayının tümüne müdahale edebiliryorlar. Şöyle bir şey yapabilir miyiz:
"sayfa korumayı kaldır" şeçildiği esnada uyarı verdirebilir miyiz ? diğer kullanıcılar şifreyi bilseler dahi müdahale etmesinler.

Şimdiden çok teşekkür ederim.
İyi çalışmalar.