Soru COMMAND BUTTONA ÇOKLU ŞİFRE BIRAKMA

[zulfuernek]

comman buttona 3 farklı şifre işlevi bırakmak istiyorum.

Örneğin şifre sorduğunda eğer şifre yerine "SİL"yazarsam Eğer "SİLİNEN" adında gizli bir sheet yoksa önce "SİLİNEN" adında yeni ve gizli bir sheet açarak sheet 1 deki ilk satır hariç geri kalan tüm bilgileri yeni açtığı "SİLİNEN" shetine yapıştıracak. Eğer "SİLİNEN" adında bir sheet varsa önce bundaki tüm bilgileri silecek ve sonra sheet 1 deki ilk satır hariç geri kalan tüm bilgileri buraya yeniden yapıştıracak.

Şifre yerine "KURTAR" yazınca silinen adındaki gizli sheetteki tüm bilgileri sheet 1 de 2. Satırdan itibaren geri yapıştırdıktan sonra "SİLİNEN" sheetini tamamen silecek ve dosyayı kaydedecek

Şifre yerine RESET yazınca ise sheet 1 de 2. Satırdan itibaren tamamen silecek ayrıca SİLİNEN adında gizli sheet mevcutsa sheeti tamamen silecek ve dosyay kaydedecek.

 

[volki_112]

Deneyiniz.

Private Sub CommandButton3_Click()

    Dim sifre As String
    Dim anaSayfa As Worksheet
    Dim silinenSayfa As Worksheet
    Dim varMi As Boolean
    Dim sonSatir As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set anaSayfa = ThisWorkbook.Sheets(1) ' İlk sayfa (Sheet1)

    ' Şifreyi sor
    sifre = InputBox("İşlem yapmak için şifrenizi girin:")

    ' Şifre büyük harfe çevrilerek kontrol edilir
    sifre = UCase(Trim(sifre))

    Select Case sifre
        Case "SİL"
            ' "SİLİNEN" sayfası var mı kontrolü
            varMi = False
            For Each ws In ThisWorkbook.Sheets
                If ws.Name = "SİLİNEN" Then
                    varMi = True
                    Set silinenSayfa = ws
                    Exit For
                End If
            Next ws

            ' Yoksa oluştur, varsa içeriğini temizle
            If Not varMi Then
                Set silinenSayfa = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                silinenSayfa.Name = "SİLİNEN"
                silinenSayfa.Visible = xlSheetVeryHidden
            Else
                silinenSayfa.Cells.Clear
            End If

            ' Ana sayfadan 2. satırdan itibaren verileri kopyala
            sonSatir = anaSayfa.Cells(anaSayfa.Rows.Count, "A").End(xlUp).Row
            If sonSatir >= 2 Then
                anaSayfa.Rows("2:" & sonSatir).Copy Destination:=silinenSayfa.Range("A2")
            End If

            MsgBox "Veriler gizli 'SİLİNEN' sayfasına yedeklendi.", vbInformation

        Case "KURTAR"
            ' "SİLİNEN" sayfası var mı kontrol
            On Error Resume Next
            Set silinenSayfa = ThisWorkbook.Sheets("SİLİNEN")
            On Error GoTo 0

            If Not silinenSayfa Is Nothing Then
                ' Ana sayfadaki eski verileri temizle
                sonSatir = anaSayfa.Cells(anaSayfa.Rows.Count, "A").End(xlUp).Row
                If sonSatir >= 2 Then
                    anaSayfa.Rows("2:" & sonSatir).ClearContents
                End If

                ' "SİLİNEN" sayfasındaki verileri ana sayfaya geri getir
                sonSatir = silinenSayfa.Cells(silinenSayfa.Rows.Count, "A").End(xlUp).Row
                If sonSatir >= 2 Then
                    silinenSayfa.Rows("2:" & sonSatir).Copy Destination:=anaSayfa.Range("A2")
                End If

                ' "SİLİNEN" sayfasını sil
                Application.DisplayAlerts = False
                silinenSayfa.Delete
                Application.DisplayAlerts = True

                ' Dosyayı kaydet
                ThisWorkbook.Save

                MsgBox "Veriler kurtarıldı ve 'SİLİNEN' sayfası silindi.", vbInformation
            Else
                MsgBox "'SİLİNEN' sayfası bulunamadı!", vbExclamation
            End If

        Case "RESET"
            ' Ana sayfadaki tüm verileri temizle
            sonSatir = anaSayfa.Cells(anaSayfa.Rows.Count, "A").End(xlUp).Row
            If sonSatir >= 2 Then
                anaSayfa.Rows("2:" & sonSatir).ClearContents
            End If

            ' "SİLİNEN" sayfası varsa onu da sil
            On Error Resume Next
            Set silinenSayfa = ThisWorkbook.Sheets("SİLİNEN")
            If Not silinenSayfa Is Nothing Then
                silinenSayfa.Delete
            End If
            On Error GoTo 0

            ' Dosyayı kaydet
            ThisWorkbook.Save

            MsgBox "Tüm veriler temizlendi ve 'SİLİNEN' sayfası varsa silindi.", vbInformation

        Case Else
            MsgBox "Geçersiz şifre! İşlem iptal edildi.", vbCritical
    End Select

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

 

[zulfuernek]

Hocam elinize sağlık. Ancak kodlarda gerekli isim değişiklikerini yaptım fakat işlev görmedi. Örnek dosyayı ekliyorum. Yönetici sayfasında sil butonuna tıklayınca SYSTEM sekmesinde gerekli 3 işlevi yapmalı