• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

kendini imha parolası konabilir mi ?

T

Tofan1975

Katılım
9 Aralık 2010
Mesajlar
11
Excel Vers. ve Dili
2003
hazırladığım bir çalışmaya parola koymak istiyorum. ancak bununla birlikte bir parola da kendini imha etmesi için bırakabilir miyim ?

örneğin; diyelim açma parolam.2 imha parolam.3 olabilir mi ?

biri çok ısrar etse görebilir miyim diye bende imha olanı veririm kökten bozulsun gitsin. bakmasını istediğim kişiye de normal parolayı veririm. ama excell de böyle bir şey söz konusu olabilir mi bilmiyorum. eminim ki böyle bir şey varsa çok kişinin işine yarayacaktır.
 
imha etmek yerine kullanıcıya göre yetkilendirme yapılabilir ki daha sağlıklı olan budur. Yani 2 parolası ile giren sadece sayfa1 i görür 3 ile giren bütün sayfaları görür gibi
 
EErkut' Alıntı:
imha etmek yerine kullanıcıya göre yetkilendirme yapılabilir ki daha sağlıklı olan budur. Yani 2 parolası ile giren sadece sayfa1 i görür 3 ile giren bütün sayfaları görür gibi
Genişletmek için tıkla ...

dediğiniz yöntemi denemek isterim. kodları verebilir misiniz ?

ayrıca ben birinde buna benzer birşey görmüştüm. farklı kullanıcı adı belirlemişti ve hangi kullanıcı ve şifreyle girerse farklı sayfalar açılıyordu. ama vba dan girilince diğer tüm sayfaları yinede görebilme imkanı vardı.
 
Necdet Yeşertener hocama ait bir kodu paylaşayım kodu ThisWorkbook bölümüne yazın

Private Sub Workbook_Open()
Dim Kullanici As String

Kullanici = InputBox("Kullanıcı Adını Giriniz", vbOKCancel, "Kullanıcı Adını Giriniz")

MsgBox "Kullanıcı : " & Kullanici

If Kullanici = "ahmet" Then
Sheets("Sayfa1").Visible = True
Sheets("Sayfa2").Visible = True
Sheets("Sayfa3").Visible = True
Sheets("Sayfa2").Select
ElseIf Kullanici = "mehmet" Then
Sheets("Sayfa1").Visible = True
Sheets("Sayfa2").Visible = False
Sheets("Sayfa3").Visible = False
Sheets("Sayfa1").Select
Else
ThisWorkbook.Close Savechanges:=False
End If

End Sub
 
Sayın EErkut;

Kodları test.xls çalışmasına uyarladım. Dosya ekte. açarken 2 veya 3 ne yazarsak yazalım açılışta tüm sayfaları göründüğü gibi şifre girince kapanıyor.
 

Ekli dosyalar

levo26' Alıntı:
Sayın EErkut;

Kodları test.xls çalışmasına uyarladım. Dosya ekte. açarken 2 veya 3 ne yazarsak yazalım açılışta tüm sayfaları göründüğü gibi şifre girince kapanıyor.
Genişletmek için tıkla ...

Merhaba,

ben uyarladım ve çalıştı, anlamadım sebebini ama kullanıcı adlarını (ahmet - mehmet) değiştirince çalıştı,

tabi ayrıca belirtmeme gerek yok sanırsam ki
Sheets("Sayfa1").Visible = True
Sheets("Sayfa2").Visible = True
......

satırlarında yer alan Sayfa1 vs... excel dili ingilizceyse Sheet1 vs.. şeklinde değiştirilmeli.

EErkut bey teşekkürler, güzel paylaşım. Necdet Hacamızında ellerine sağlık. buna bide şifre ekledikmi tamamdır... :biggrin:
 
Merhaba,

Alternatif olarak aşağıdaki kodu denermisiniz.

Çalışmanızın ThisWorkbook bölümüne uygulayınız.

Kod: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.WindowState = xlMinimized
    If Excel.Application.Windows.Count = 1 Then
        ThisWorkbook.IsAddin = True
        ThisWorkbook.Save
    Else
        ThisWorkbook.IsAddin = True
        ThisWorkbook.Close 1
    End If
End Sub
 
Private Sub Workbook_Open()
    Dim Kullanıcı As String, Sayfa As Worksheet
 
    ThisWorkbook.IsAddin = True
 
    Kullanıcı = InputBox("Kullanıcı Adını Giriniz", , "Kullanıcı Adı")
 
    Kullanıcı = UCase(Replace(Replace(Kullanıcı, "ı", "I"), "i", "İ"))
 
    MsgBox "Kullanıcı : " & Kullanıcı
 
    If Kullanıcı = "ADMİN" Then
        Application.WindowState = xlMinimized
        ThisWorkbook.IsAddin = False
        For Each Sayfa In ThisWorkbook.Worksheets
            Sayfa.Visible = True
        Next
        Sheets(1).Activate
        Application.WindowState = xlMaximized
 
    ElseIf Kullanıcı = "AHMET" Then
        Application.WindowState = xlMinimized
        ThisWorkbook.IsAddin = False
        For Each Sayfa In ThisWorkbook.Worksheets
            Sayfa.Visible = True
        Next
        For Each Sayfa In ThisWorkbook.Worksheets
            If Sayfa.Name = "Sayfa1" Or Sayfa.Name = "Sayfa2" Or Sayfa.Name = "Sayfa3" Then
                Sayfa.Visible = True
            Else
                Sayfa.Visible = 2
            End If
        Next
        Sheets(1).Activate
        Application.WindowState = xlMaximized
 
    ElseIf Kullanıcı = "MEHMET" Then
        Application.WindowState = xlMinimized
        ThisWorkbook.IsAddin = False
        For Each Sayfa In ThisWorkbook.Worksheets
            Sayfa.Visible = True
        Next
        For Each Sayfa In ThisWorkbook.Worksheets
            If Sayfa.Name = "Sayfa4" Or Sayfa.Name = "Sayfa5" Or Sayfa.Name = "Sayfa6" Then
                Sayfa.Visible = True
            Else
                Sayfa.Visible = 2
            End If
        Next
        Sheets(1).Activate
        Application.WindowState = xlMaximized
 
    Else
        MsgBox "Dosyayı kullanmak için yetkili değilsiniz !" & Chr(10) & "Dosya kapanacaktır.", vbCritical
        Application.WindowState = xlMinimized
        ThisWorkbook.IsAddin = False
        If Excel.Application.Windows.Count = 1 Then
            Application.DisplayAlerts = False
            Application.Quit
        Else
            ThisWorkbook.Close 0
        End If
    End If
End Sub
 

Ekli dosyalar

Merhaba,

Bir üstteki örnek çalışmada excel uygulamasının taskbarda görünmesi sorunu vardı. Bu çalışmada sayfalar döngü ile gizlendiği için dosya kapanması sorunu olmuyor. Tabi çok sayfalı çalışmalarda yavaşlama yaşanabilir.

Kodu ThisWorkbook bölümüne uygulayın.

Kod: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.WindowState = xlMinimized
    For Each Sayfa In ThisWorkbook.Worksheets
        Sayfa.Visible = True
    Next
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> "." Then Sayfa.Visible = 2
    Next
    If Excel.Application.Windows.Count = 1 Then
        ThisWorkbook.Save
    Else
        ThisWorkbook.Close 1
    End If
End Sub
 
Private Sub Workbook_Open()
    Dim Kullanıcı As String, Sayfa As Worksheet
 
    ThisWorkbook.IsAddin = True
 
    Kullanıcı = InputBox("Kullanıcı Adını Giriniz", , "Kullanıcı Adı")
 
    Kullanıcı = UCase(Replace(Replace(Kullanıcı, "ı", "I"), "i", "İ"))
 
    MsgBox "Kullanıcı : " & Kullanıcı
 
    If Kullanıcı = "ADMİN" Then
        Application.WindowState = xlMinimized
        ThisWorkbook.IsAddin = False
        For Each Sayfa In ThisWorkbook.Worksheets
            If Sayfa.Name <> "." Then
                Sayfa.Visible = True
            Else
                Sayfa.Visible = 2
            End If
        Next
        Sheets(1).Activate
        Application.WindowState = xlMaximized
 
    ElseIf Kullanıcı = "AHMET" Then
        Application.WindowState = xlMinimized
        ThisWorkbook.IsAddin = False
        For Each Sayfa In ThisWorkbook.Worksheets
            Sayfa.Visible = True
        Next
        For Each Sayfa In ThisWorkbook.Worksheets
            If Sayfa.Name = "Sayfa1" Or Sayfa.Name = "Sayfa2" Or Sayfa.Name = "Sayfa3" Then
                Sayfa.Visible = True
            Else
                Sayfa.Visible = 2
            End If
        Next
        Sheets(1).Activate
        Application.WindowState = xlMaximized
 
    ElseIf Kullanıcı = "MEHMET" Then
        Application.WindowState = xlMinimized
        ThisWorkbook.IsAddin = False
        For Each Sayfa In ThisWorkbook.Worksheets
            Sayfa.Visible = True
        Next
        For Each Sayfa In ThisWorkbook.Worksheets
            If Sayfa.Name = "Sayfa4" Or Sayfa.Name = "Sayfa5" Or Sayfa.Name = "Sayfa6" Then
                Sayfa.Visible = True
            Else
                Sayfa.Visible = 2
            End If
        Next
        Sheets(1).Activate
        Application.WindowState = xlMaximized
 
    Else
        MsgBox "Dosyayı kullanmak için yetkili değilsiniz !" & Chr(10) & "Dosya kapanacaktır.", vbCritical
        Application.WindowState = xlMinimized
        ThisWorkbook.IsAddin = False
        If Excel.Application.Windows.Count = 1 Then
            Application.DisplayAlerts = False
            Application.Quit
        Else
            ThisWorkbook.Close 0
        End If
    End If
End Sub
 

Ekli dosyalar

Merhaba Sayın Korhan Ayhan,

Çözümden ben de faydalandım, teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst