Dosya şifreleme

[marlalı1]

Arkadaşlar ekteki dosyayı incelermisiniz.

 

[Ömer]

Merhaba,

Thisworbook sayfasının kod bölümüne kopyalayınız..

Private Sub Workbook_Open()
If Date >= CDate("[COLOR=red]31.12.2009[/COLOR]") Then
sifre = InputBox("Devam edebilmek için şifre girmelisiniz!", "Progranım Kullanım Süresi Dolmuştur")
If sifre <> "[COLOR=red]abcd[/COLOR]" Then
MsgBox "yanlış şifre kapatıyoruz"
ThisWorkbook.Close
End If
End If
End Sub

Kodlar alıntıdır..

.

 

[marlalı1]

bunu ektelki dosyada yapabilirmisiniz

 

[Ömer]

bunu ektelki dosyada yapabilirmisiniz

Dosyanız ektedir..

Şifre : abcd

.

 

[marlalı1]

ya hocam çok sağol eline sağlık.fakat amkro güvenliği etkinleştirince soruyor şifreyi.etkinleştirmezsem sormuyor.bunu bir çözüm varmı acaba

 

[ramboberk]

Dosyanız ektedir..

Şifre : abcd

.

Ömer bey bu kodlarınızı inceledim ve aklıma bir şey geldi. bu kodu belli bir tarihten sonra Dosya içinde a sayfasından b sayfasına geçilmek istendiğinde şifre soracak şekilde nasıl düzenlemek gerekir. bu arada şifre yanlış girildiğinde dosyayı kapatmamalı A sayfasına geri dönmeli.... Teşekkürler..

 

[Ömer]

Ömer bey bu kodlarınızı inceledim ve aklıma bir şey geldi. bu kodu belli bir tarihten sonra Dosya içinde a sayfasından b sayfasına geçilmek istendiğinde şifre soracak şekilde nasıl düzenlemek gerekir. bu arada şifre yanlış girildiğinde dosyayı kapatmamalı A sayfasına geri dönmeli.... Teşekkürler..

Şifrelemek istediğiniz sayfanın kod bölümüne yazınız..

Private Sub Worksheet_Activate()
If Date >= CDate("[COLOR=red]31.12.2008[/COLOR]") Then
Application.Visible = False
Sifre = InputBox("Devam edebilmek için şifre girmelisiniz!")
If Sifre <> "[COLOR=red]x[/COLOR]" Then
MsgBox "Yanlış Şifre A Sayfasına Döndünüz"
Sheets("A").Select
End If
Application.Visible = True
End If
End Sub

Yalnız, Sayın marlalı'nında belirttiği gibi makroları etkinleştirmezseniz makro çalışmayacağı için bir anlam ifade etmeyecektir..

.

 

[ramboberk]

Şifrelemek istediğiniz sayfanın kod bölümüne yazınız..

Private Sub Worksheet_Activate()
If Date >= CDate("[COLOR=red]31.12.2008[/COLOR]") Then
Application.Visible = False
Sifre = InputBox("Devam edebilmek için şifre girmelisiniz!")
If Sifre <> "[COLOR=red]x[/COLOR]" Then
MsgBox "Yanlış Şifre A Sayfasına Döndünüz"
Sheets("A").Select
End If
Application.Visible = True
End If
End Sub

Yalnız, Sayın marlalı'nında belirttiği gibi makroları etkinleştirmezseniz makro çalışmayacağı için bir anlam ifade etmeyecektir..

.

Ömer bey kod güzel çalışıyor elinize sağlık. Ancak şöyle bir durum var ve ben belirtmeyi unuttum. A sayfası olarak belirttiğim sayfada bazı bilgiler girdiğimde bu bilgileri bir kodla b sayfasına taşıyorum. ancak sizin kodu uyguladığımda doğal olarak her bilgi taşımak istediğimde şifre istiyor. bunu nasıl aşabilirim. yani ben bilgi taşımak istediğimde sormamalı şifreyi veya b sayfasına bilgi gönderdiğimde değilde yine b sayfasından herhangi bir hücre silmek istediğimde sormalı A sayfası olarak ifade ettiğim giriş sayfasından b sayfası olarak ifade ettiğim Veri tabanı isimli sayfaya veri aktarırken kullandığımız kod aşağıdadır. b sayfasına kopyalama yapacağı zaman şifreyi otomatik olarak benim kod dan girmesini sağlamakta mümkün olabilirmi.

Sub Aktar()
Dim sv As Worksheet
Dim SonSat As Long
Dim c As Range
Dim Evet As String
Set sv = Sheets("VERİ TABANI")
Evet = vbYes
Application.ScreenUpdating = False
Set c = sv.Range("B:B").Find([C6], LookIn:=xlValues)
If Not c Is Nothing Then
Evet = MsgBox([C6] & " Nolu Tutanak Var, Yeni Bir Kayıt Gibi Kaydetmek İster Misiniz?", vbYesNo)
End If
If Evet = vbYes Then
SonSat = sv.[A65536].End(3).Row + 1
Range("C6:C15").Copy
sv.Range("B" & SonSat).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
sv.Range("A" & SonSat) = SonSat - 2
Application.CutCopyMode = False
End If
' kaydı tamamlanan bilgiyi sil..
Range("C6:C14").ClearContents
Range("C6").Select
Application.ScreenUpdating = True
End Sub
Teşekkürler ilginiz için...