Çalışma Kitabına Demo Kısıtlaması Koyma Yardımı

[Believing]

Sayın Uzman Arkadaşlar,

    Private Sub Workbook_Activate()
    Dim Sureson As Date
    Dim Bugun As Date
        Sureson = "07.05.2017" ' Buradaki tarihi belirleyin
        Bugun = Date
        If Bugun > Sureson Then
            sifre = InputBox("Devam edebilmek için şifre girmelisiniz!", " PROGRAM KULLANIM SÜRESİ DOLMUŞTUR")
            If sifre <> "DEMO" Then ' Bu şifeyi değiştirin
            ActiveWorkbook.Save
            Application.Quit
        End If
        End If
        If Sureson > Bugun Then
        MsgBox ("- Kullanım için " & Sureson - Bugun & " gününüz kalmıştır." & vbLf & "- Süre Bitiminde Program Kilitlenecektir"), vbQuestion, " D İ K K A T"
        End If
        If Sureson = Bugun Then
        MsgBox ("- Programın kullanım süresi bu gün son." & vbLf & "- Gece saat 00:00 'da Program kilitlenecektir" & vbLf & "- Bilginize"), vbQuestion, " U Y A R I"
        End If
    End Sub

Yukarıdaki kodlara iki farklı özellik eklenmesini rica ediyorum. Konuya oldukca yabancıyım.
1)Belirlenen tarih geldiğinde ANA SAYFA dışındaki tüm sayfaların gizlenmesini, şifrenin girilmesi durumunda gizli sayfaların açılması;
2)makroların etkinleştirmeden açılması durumunda da sadece ANA SAYFA görünmeli ve kısıtlamaların kaldırılması durumunda ise şifre istenmelidir. Böylece eski verilere sadece şifreyi bilen yetkililerin ulaşmasının sağlanması istenmektedir.
Oysa mevcut durumda makroların etkinleştirmeden açılması durumunda tüm sayfaları yetki sahibi olmayanlar görebilmektedir.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

 

[askm]

Private Sub Workbook_Activate()
Dim Sureson As Date
Dim Bugun As Date
    Sureson = "06.05.2017" ' Buradaki tarihi belirleyin
    Bugun = Date
    If Bugun > Sureson Then
        sifre = InputBox("Devam edebilmek için şifre girmelisiniz!", " PROGRAM KULLANIM SÜRESİ DOLMUŞTUR")
        If sifre <> "DEMO" Then ' Bu şifeyi değiştirin
        gizle
'        ActiveWorkbook.Save
'        Application.Quit
    End If
    End If
    If Sureson > Bugun Then
    MsgBox ("- Kullanım için " & Sureson - Bugun & " gününüz kalmıştır." & vbLf & "- Süre Bitiminde Program Kilitlenecektir"), vbQuestion, " D İ K K A T"
    End If
    If Sureson = Bugun Then
    gizle
    MsgBox ("- Programın kullanım süresi bu gün son." & vbLf & "- Gece saat 00:00 'da Program kilitlenecektir" & vbLf & "- Bilginize"), vbQuestion, " U Y A R I"
    End If
End Sub

Sub gizle()
For Each goster In Worksheets
        If goster.Name <> "ANA SAYFA" Then
            goster.Visible = xlVeryHidden
        End If
Next
End Sub

 

[Believing]

Sayın askım,

Konuya gösterdiğiniz ilgi için size çok ama çok teşekkür ederim.
Her koşulda ANA SAYFA dışındaki sayfalar gizli gelmektedir. Yani demo tarihini bugünden ileriye veya geriye almamız durumunda herhangi bir değişiklik olmamaktadır.
Oysa İstenen belirlenmiş tarihe ulaşıldığında ANA SAYFA dışındaki tüm sayfaların gizlenerek, çalışma kitabı açıldığında ise yetki sahipleri için belirlenmiş şifre girişinin yapılması sağlanacaktır.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

 

[askm]

Goster kısmını atlamışım.

Private Sub Workbook_Activate()
Dim Sureson As Date
Dim Bugun As Date
    Sureson = "07.05.2017" ' Buradaki tarihi belirleyin
    Bugun = Date
    If Bugun > Sureson Then
        sifre = InputBox("Devam edebilmek için şifre girmelisiniz!", " PROGRAM KULLANIM SÜRESİ DOLMUŞTUR")
        If sifre <> "DEMO" Then ' Bu şifeyi değiştirin
        gizle
    Else
        goster
'        ActiveWorkbook.Save
'        Application.Quit
    End If
    End If
    If Sureson > Bugun Then
    MsgBox ("- Kullanım için " & Sureson - Bugun & " gününüz kalmıştır." & vbLf & "- Süre Bitiminde Program Kilitlenecektir"), vbQuestion, " D İ K K A T"
    End If
    If Sureson = Bugun Then
        gizle
        MsgBox ("- Programın kullanım süresi bu gün son." & vbLf & "- Gece saat 00:00 'da Program kilitlenecektir" & vbLf & "- Bilginize"), vbQuestion, " U Y A R I"
    Else
        goster
    End If
End Sub

Sub gizle()
For Each sayfa In Worksheets
        If sayfa.Name <> "ANA SAYFA" Then
            sayfa.Visible = xlVeryHidden
        End If
Next
End Sub

Sub goster()
For Each sayfa In Worksheets
    sayfa.Visible = True
Next
End Sub

 

[Believing]

Sayın askım,
Maalesef istenilen olmadı kullanım süresi dolmada şifre sormaktadır. Oysa demo tarihine gelinceye kadar çalışma kitabının tüm sayfaları aktif olmalı ve şifre sormamalıdır. Kullanım süresi dolduğu durumlarda, yanı tarih bugünden küçükse ANA SAYFA dışındaki tüm sayfalar gizlenmeli ve şifre penceresi açılarak yetki sahibi kişiler girebilmelidir.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

 

[askm]

Private Sub Workbook_Activate()
Dim Sureson As Date
Dim Bugun As Date
    Sheets("Bilgi").Visible = xlVeryHidden
    Sureson = CDate(Sheets("Bilgi").Cells(1, 1)) '"07.05.2017" ' Buradaki tarihi belirleyin
    Bugun = Date
    If Bugun + 2 > Sureson Then
        sifre = InputBox("Devam edebilmek için şifre girmelisiniz!", " PROGRAM KULLANIM SÜRESİ DOLMUŞTUR")
        If sifre <> "DEMO" Then ' Bu şifeyi değiştirin
            gizle
        Else
            Sheets("Bilgi").Cells(1, 1).Value = Sheets("Bilgi").Cells(1, 1).Value + 360
            goster
'        ActiveWorkbook.Save
'        Application.Quit
        End If
    End If
    If Sureson > Bugun Then
    MsgBox ("- Kullanım için " & Sureson - Bugun & " gününüz kalmıştır." & vbLf & "- Süre Bitiminde Program Kilitlenecektir"), vbQuestion, " D İ K K A T"
    End If
    If Sureson = Bugun Then
        gizle
        MsgBox ("- Programın kullanım süresi bu gün son." & vbLf & "- Gece saat 00:00 'da Program kilitlenecektir" & vbLf & "- Bilginize"), vbQuestion, " U Y A R I"
    End If
End Sub

Sub gizle()
For Each sayfa In Worksheets
        If sayfa.Name <> "ANA SAYFA" Then
            sayfa.Visible = xlVeryHidden
        End If
Next
End Sub

Sub goster()
For Each sayfa In Worksheets
If sayfa.Name <> "Bilgi" Then
    sayfa.Visible = True
End If
Next
End Sub

 

[Believing]

Sayın askm,

Run-time error'9':
Subscript out of range

hatası veriyor.
Debug butonuna basınca

Sheets("Bilgi").Visible = xlVeryHidden

 

[askm]

Bilgi adında sayfa eklediniz mi?