excel açılış şifresi

[musculus2]

Excel açıldığında şifre sormasını istedim ama sistem tam çalışmadı.
Nerede hata yaptığımıda bulamadım.
Şifreyi doğru girdiğim halde yanlışmış gibi çıkış yapıyor.

Private Sub Workbook_Open()

If Sheets("sayfa1").Range("bg1").Value = 1 Then

sor = InputBox("açılış şifresini giriniz")
'MsgBox Sheets("sayfa1").Range("bg2").Value

If sor = Sheets("sayfa1").Range("bg2").Value Then

Application.Visible = False
UserForm1.Show 0
Exit Sub
Else

ActiveWorkbook.Save
MsgBox "çıkış"
'Excel.Application.Quit
End If

Else
Application.Visible = False
UserForm1.Show 0
End If
End Sub

 

[cems]

Şifreyi sayfada değil inputbox kodu içinde aratın .

Private Sub Workbook_Open()

sor = InputBox("açılış şifresini giriniz")
If sor = 1 Then
MsgBox " Şifre doğrulandı"
Application.Visible = False
UserForm1.Show
Exit Sub
End If

If sor <> 1 Then
Msgbox " Şifre hatalı, dosya korunarak kapatılacak" 

ThisWorkbook.Save
MsgBox "çıkış"
Application.Visible = True
Unload UserForm1
'Application.Quit      ' Baştaki işareti kaldırırsanız kitap kapatılır.

End If
End Sub

Bir hatırlatma : excel sayfalarını gizlediğinizde , bir şekilde çıkış anında excel sayfalarını mutlaka görünürleştirmelisiniz. Aksi durumda açtığınız dosyada da sayfanın görünmemesi sorunu yaşarsınız.

 

[musculus2]

Çok teşekkür ederim.
Fakat şifre daha sonra değiştirilebilir olduğundan hücreye yazmıştım.
Hücredeki değere göre kontrol edebilir miyiz ?

 

[Orion1]

Excelin güvenlik düzeyi yükseltilirse makrolar devre dışı kalır ve dosya açılır.

 

[musculus2]

Teşekkür ederim.