Belirli sayfaları toplu olarak şifreleme hk.

[hakanaslan78]

Merhaba Arkadaşlar,

Sizden bir konu da yardım rica edeceğim. Excel çalışma kitabım da 30 adet sekmem bulunuyor ve bu sekmeleri toplu bir şekilde şifreli korumak istiyorum. Şöyle bir durum var, sekmekler den birinde sql den veriler yenile özelliği ile geldiğinden dolayı koruma işlemi yaptığım da, verileri yenileme sekmesi kullanılmaz hale geliyor. Benim sizden ricam, hangi sekmelerin toplu bir şekilde korunacağını kendim belirlemem. Yardımlarınız için şimdiden çok teşekkürler.

Saygılarımla,

Hakan ASLAN

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Belli_Sayfalari_Koru()
    Dim Sayfa As Worksheet
    
    For Each Sayfa In Sheets(Array("Sayfa1", "Sayfa3", "Sayfa5"))
        Sayfa.Protect "12345"
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[hakanaslan78]

Deneyiniz.

Option Explicit

Sub Belli_Sayfalari_Koru()
    Dim Sayfa As Worksheet
   
    For Each Sayfa In Sheets(Array("Sayfa1", "Sayfa3", "Sayfa5"))
        Sayfa.Protect "12345"
    Next
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Korhan Bey çok teşekkür ederim. Unuttuğum bir nokta oldu, koruduğumuz sayfaları, tekrar dan şifrelerini kaldırmak için, açılan bir pencere ile şifre girerek korumalarını da kaldırmak gerekecek. Bu konuda da yardımınızı rica edeceğim.

Saygılarımla,

Hakan ASLAN

 

[Korhan Ayhan]

Deneyiniz.

Sub Koruma_Kaldir()
    Dim Parola As Variant, Sayfa As Worksheet
    
    Parola = InputBox("Lütfen sayfa koruma şifresini giriniz!", "ŞİFRE GİRİŞİ")
    
    If Parola = "" Or Parola = False Then
        MsgBox "İşleminiz iptal edilmiştir!", vbExclamation
        Exit Sub
    End If
    
    If Parola <> 12345 Then
        MsgBox "Hatalı şifre girişi yaptınız!" & vbCr & "Lütfen daha sonra tekrar deneyiniz.", vbCritical
        Exit Sub
    Else
        For Each Sayfa In Sheets(Array("Sayfa1", "Sayfa3", "Sayfa5"))
            Sayfa.Unprotect Parola
        Next
        
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
End Sub

 

[hakanaslan78]

Deneyiniz.

Sub Koruma_Kaldir()
    Dim Parola As Variant, Sayfa As Worksheet
   
    Parola = InputBox("Lütfen sayfa koruma şifresini giriniz!", "ŞİFRE GİRİŞİ")
   
    If Parola = "" Or Parola = False Then
        MsgBox "İşleminiz iptal edilmiştir!", vbExclamation
        Exit Sub
    End If
   
    If Parola <> 12345 Then
        MsgBox "Hatalı şifre girişi yaptınız!" & vbCr & "Lütfen daha sonra tekrar deneyiniz.", vbCritical
        Exit Sub
    Else
        For Each Sayfa In Sheets(Array("Sayfa1", "Sayfa3", "Sayfa5"))
            Sayfa.Unprotect Parola
        Next
       
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
End Sub

Çok teşekkür ederim. Emeğinize sağlık.

 

[xternet]

Merhaba Arkadaşlar,
Sayın Korhan Ayhan'ın kodları çok güzel çalışıyor. Eline, zihnine sağlık.
Bu kodları çalışma kitabının farklı şekillerde adlandırılmış tüm sayfalarını şifrelemek ve çözmek için nasıl düzenleyebiliriz?
Tüm ilgilenen arkadaşlara şimdiden çok teşekkür ediyorum.

Bir şey daha eklemek istiyorum.
Buradaki şifre kaldırma kodu otomatik nasıl çözülür?
Yani "koruma kaldır" makrosu çalıştırıldığında şifre sormadan koruma kalkacak şekilde nasıl düzenlenebilir?

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sayfalari_Koru()
    Dim Sayfa As Worksheet
    
    For Each Sayfa In WorkSheets
        Sayfa.Protect "12345"
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Sub Koruma_Kaldir()
    Dim Sayfa As Worksheet   

    For Each Sayfa In WorkSheets
        Sayfa.Unprotect 12345
    Next
       
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[xternet]

Teşekkürler Sayın Korhan Ayhan, elinize zihninize sağlık.

 

[xternet]

Yeniden merhaba arkadaşlar.
Sayın Korhan Ayhan'ın yukarıda yazdığı kod excel 2010 da sorunsuz çalışırken
maalesef 2021 de zaman zaman sorun çıkarıyor. Bu kodlara alternatif ne olabilir?

Bu konu ile alakalı seçenekleri inceledim ama olmadı.

Hatta daha önce :

For a = 1 To Sheets.Count
Sheets(a).Protect "1234" = True
Next

kodunu kullanıyordum. Sorun yaşayınca yukarıdaki koda geçmiştim.

 

[Korhan Ayhan]

Yaşadığınız sorun nedir?

 

[xternet]

Kod farklı çalışıyor ve çalışılan sayfaların içeriği bozuluyor.

Program içerisinde oluşturduğum tüm kodlarda , önce tüm sayfaların korumasını kaldıracak şekilde ilk satıra yukarıda sizin yazdığınız kodu ekliyorum.
Sayfa korumaları kalkıyor ve sonra kodun içeriği çalışıyor. Bitirince de tekrar tüm sayfalara koruma ekliyorum ve işlem bitiyor. Hepsi aynı kod içerisinde.

Ama 2021 de, hatta 2016 sonrası versiyonlarda tabiri caizse kod sapıtıyor.

Sayfa korumalarını öncesinden kaldırıp işlemi uyguladığımda sorun yok.

Ayrıca tüm bu sorunlardan 2010 da eser yok. excel 2010 da her şey daha hızlı ve sorunsuz.

 

[xternet]

Bahsettiğim kod bu
(Yazdığım kodları farklı uygulamalardan uyarladığım için biraz hantal bir yapıya sahip sanırım.)

Sorunu çözmek için uyguladığım başka bir deneme de pasif olarak kodların arasında


Sub SECMELİ_SINIFLAR_İÇİN_DAĞITIM_OLUSTURMA_V3()


Application.ScreenUpdating = False

a = MsgBox(Range("CA12") & Chr(10) & Chr(10) & _
Range("CA13") & Chr(10) & Chr(10) & _
Range("CA14") & Chr(10) & Chr(10) & _
Range("CA15") & Chr(10) & Chr(10) & _
Range("CA16"), vbOKCancel, Range("CA11"))
If a = vbOK Then
On Error GoTo Atla

Dim Sayfa As Worksheet
For Each Sayfa In Worksheets
Sayfa.Unprotect "..."
Next

'şifre çözülüyor
' Dim Sayfa, Sayfa_2, Sayfa_3, Sayfa_4 As Worksheet
' For Each Sayfa In Sheets(Array("GENEL"))
' Sayfa.Unprotect "..."
' Next
' For Each Sayfa_2 In Sheets(Array("TUM_SNF_LİST"))
' Sayfa_2.Unprotect "..."
' Next
' For Each Sayfa_3 In Sheets(Array("SNF_LİST"))
' Sayfa_3.Unprotect "..."
' Next
' For Each Sayfa_4 In Sheets(Array("SNF_DGTM"))
' Sayfa_4.Unprotect "..."
' Next

BEKLE_3.Show 0
DoEvents


'Seçmeli sınıflar sağda listeleniyor
Range("AL10:AY49").ClearContents

Application.ScreenUpdating = True
Dim X As Integer
For k = 10 To 49

If Range("Q" & k) = [Q9] Then

Range("U" & k & ":" & "AH" & k).Copy

Range("AL" & X + 10 & ":" & "AY" & X + 10).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else: GoTo Pasgec
End If
X = X + 1
Pasgec:
Next k
Range("A1").Select
'Sınıf listeleme bitti.



Application.CutCopyMode = False
Application.ScreenUpdating = False
'Seçilen sınıflara ait öğreci listesi hazırlanıyor.
Range("BU10:BY1929").ClearContents
Dim Y As Integer
For k = 10 To [BT8]

For t = 10 To 1929

If Range("J" & t) = Range("AL" & k) Then

Range("J" & t & ":" & "N" & t).Copy

Range("BU" & Y + 10 & ":" & "BY" & Y + 10).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else: GoTo Pasgec_2
End If
Y = Y + 1
Pasgec_2:
Next t

Next k

Range("A1").Select
'öğrenci listesi hazır



'Seçilen sınıf ADLARI GENEL sayfasına aktarılıyor
Range("AL10:AM29").Copy
Sheets("GENEL").Select
Range("M18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("TUM_SNF_LİST").Select
Range("AL30:AM49").Copy
Sheets("GENEL").Select
Range("P18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
'Seçilen sınıfların GENEL sayfasına aktarımı bitti


'Seçilen sınf listeleri aktarılıyor
Sheets("TUM_SNF_LİST").Select
Range("BU10:BY1929").Copy
Sheets("SNF_LİST").Select
Range("J10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select

'sol başa sıra numarası ekleniyor

Range("I10:I1929").ClearContents

'9,10,11,12 İÇİN KOPYALANIYOR


For s = 1 To [BC21]
[BC20] = s

Range("AP" & [AR10] & ":AP" & [BC23]).Copy
Range("I" & [BC22]).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next s

'KOPYALAMA MODU KAPANIYOR
Application.CutCopyMode = False
Range("AL11") = Range("AL10") 'sıra no düzenle kontrolü için

'tüm öğrenci listesi sıfırlanıyor
'SİLME
Range("T10:W1929").ClearContents

Range("AH10:AJ1929").Copy
Range("U10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'KOPYALAMA MODU KAPANIYOR
Application.CutCopyMode = False
Range("A1").Select
'SEÇİLEN SINIF LİSTELERİNİN AKTARIMI bitti


'SINIFLARDAKİ SIRA DÜZENLERİ AYARLANIYOR.
'seçilen sınıfların sıra düzenleri aktarılıyor
Sheets("SNF_DGTM").Select

For i = 25 To 233 Step 16

Range("JV" & i & ":LJ" & i).Copy
Range("BM" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next

Application.CutCopyMode = False
Range("A1").Select
'Sınıflardaki sıra düzenlemesi aktarıldı


'şimdi x ler yerleştiriliyor
For a = 26 To 234 Step 16

Range("HM" & a & ":JA" & a + 5).Copy
Range("BM" & a).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Next
'x ler yerleşti


'SINIFLARIN SIRA DÜZENLERİ AYARLANDI

Sheets("TUM_SNF_LİST").Select
Range("A1").Select



Atla:
Application.ScreenUpdating = True
MsgBox Range("CA18")
Else
MsgBox Range("CA17")
End If

Application.ScreenUpdating = True
Range("A1").Select

Unload BEKLE_3

'şifreleniyor
' For Each Sayfa In Sheets(Array("GENEL"))
' Sayfa.Protect "..."
' Next
' For Each Sayfa_2 In Sheets(Array("TUM_SNF_LİST"))
' Sayfa_2.Protect "..."
' Next
' For Each Sayfa_3 In Sheets(Array("SNF_LİST"))
' Sayfa_3.Protect "..."
' Next
' For Each Sayfa_4 In Sheets(Array("SNF_DGTM"))
' Sayfa_4.Protect "..."
' Next


For Each Sayfa In Worksheets
Sayfa.Protect "..."
Next

End Sub

 

[Korhan Ayhan]

Şöyle yapalım...

2021 sürümde siz sadece benim önerdiğim kodu çalıştırıp sonucu paylaşabilirmisiniz.

 

[xternet]

Aynı dosya üzerinde aynı makroyu 2010 ve 2021 ile çalıştırarak ekran görüntüsünü kaydettim.
2021 dosyanın veri yapısını bozarak tamamlıyor.

2010 ile.mp4 - 13.3 MB
2021 ile.mp4 - 21.5 MB

 

[Korhan Ayhan]

Benim önerdiğim kod bloğunda userform yok.

Benim önerdiğim kodu kopyalayarak 2021 sürüm olan pc de mesela 5 sayfa içeren yeni bir excel dosyası oluşturup öyle deneyiniz. Test için sayfalarda hücreleri renklendirerek kenarlık ekleyebilirsiniz. Böylece kod çalıştıktan sonra bozulma oluyormu görebilirsiniz. Benim tahminim bozulma olmayacaktır.

Bu şekilde deneme yaparak sonucu bildirebilirseniz sevinirim.

 

[xternet]

Sayın Korhan Ayhan şunu da ifade edeyim:

Yukarıda video örneği verdiğim kodu çalıştırmadan önce,
bu koddan bağımsız olarak sizin koruma kaldırma kodu ile tüm sayfaların kodunu kaldırdıktan sonra
korumasız sayfalarda videoda gösterdiğim kod sorun çıkarmadan çalışıyor.


Bu kod bu şekilde sorun çıkarınca şu şekilde sorunu aşmıştım:

'şifre çözülüyor
Dim Sayfa, Sayfa_2 As Worksheet
For Each Sayfa In Sheets(Array("SNF_LİST"))
Sayfa.Unprotect "1992ykskdk9334"
Next
For Each Sayfa_2 In Sheets(Array("TUM_SNF_LİST"))
Sayfa_2.Unprotect "1992ykskdk9334"
Next
.
.
.
.

'şifreleniyor
For Each Sayfa In Sheets(Array("SNF_LİST"))
Sayfa.Protect "1992ykskdk9334"
Next
For Each Sayfa_2 In Sheets(Array("TUM_SNF_LİST"))
Sayfa_2.Protect "1992ykskdk9334"
Next

Yani sadece kodun işlem yapacağı sayfaların korumasını kaldırtıyordum.

Ama bu taktik, bu kodda işe yaramadı.

Buradan bir sonuç çıkar mı bilemiyorum.

 

[xternet]

Yeniden merhaba Sayın Korhan Ayhan,

Yukarıdaki mesajı yazdıktan sonra şöyle bir şeyi denemek aklıma geldi:

Sadece çalışılan sayfaların kodları çözülsün diye üst kısma eklediğim aşağıdaki kod grubu vardı ve sorun yaşıyordum.


'şifre çözülüyor
Dim Sayfa, Sayfa_2, Sayfa_3, Sayfa_4 As Worksheet
For Each Sayfa In Sheets(Array("GENEL"))
Sayfa.Unprotect "..."
Next
For Each Sayfa_2 In Sheets(Array("TUM_SNF_LİST"))
Sayfa_2.Unprotect "..."
Next
For Each Sayfa_3 In Sheets(Array("SNF_LİST"))
Sayfa_3.Unprotect "..."
Next
For Each Sayfa_4 In Sheets(Array("SNF_DGTM"))
Sayfa_4.Unprotect "..."
Next


Bu kez her şifre çözücü kodu, kod akışı içerisinde çalışılacak sayfanın hemen önüne yazdım ve kod doğru şekilde çalıştı.

'şifre çözülüyor

Dim Sayfa As Worksheet
For Each Sayfa In Sheets(Array("GENEL"))
Sayfa.Unprotect "..."
Next
.
.
Dim Sayfa_2 As Worksheet
For Each Sayfa_2 In Sheets(Array("TUM_SNF_LİST"))
Sayfa_2.Unprotect "..."
Next
.
.
Dim Sayfa_3 As Worksheet
For Each Sayfa_3 In Sheets(Array("SNF_LİST"))
Sayfa_3.Unprotect "..."
Next
.
.
Dim Sayfa_4 As Worksheet
For Each Sayfa_4 In Sheets(Array("SNF_DGTM"))
Sayfa_4.Unprotect "..."
Next

Kodun sonuna da,
For Each Sayfa In Worksheets
Sayfa.Protect "..."
Next
kodunu ekleyerek tekrar koruma sağladım.

Yalnız bu şekilde de şöyle bir sorun var. Kod 2010 da 20 sn de işini tamamlıyor,
2021 de ise yaklaşık 4-5 dakika sürüyor.

Bunun sebebi yazdığım kodların hantallığı diye düşünüyorum ama,
2010 da gayet stabil iken 2021 de bu kadar kasmasını da anlayamıyorum.

 

[Korhan Ayhan]

Makroda kullanılan .Select komutu makronun performan kaybına yol açmaktadır.

Kodlamada bir çok işlemi Kitap-Sayfa-Hücre seçmeden yapabilirsiniz.

Bunun için SET komutunu kullanarak objeleri tanımlamak gerekir. Zaten bu şekilde kullanım kod yazmanın temelini oluşturur.

Bugün yapay zekaya bile kod yazdırdığınızda hemen her değişkeni tanımlayarak size cevap verecektir.

İşin özünde benim önerdiğim kodlar sizin bahsettiğiniz biçim bozukluklarına sebep olmaz. Bu sebeple size sadece benim önerdiğim kodu boş bir kitapta denemenizi önerdim. Bunu yaptıysanız bozulma olmadığınız görebilirsiniz.

Bozulmaya sebep olan sizin tabiri caizse toplama kodlarınız bu bozuulmaya sebep olmaktadır. Excel sürümleri sürekli gelişerek ilerlemektedir. Bu sebeple bazı komutlarda farklılık olabiliyor. Bir sürümde çalışan özellik diğer sürümde sorun çıkarabiliyor.

Kod yazarken tanımlamaları kullanmayı alışkanlık haline getirmeniz menfaatinize olacaktır. En azından bu açıdan kodlarınızda eksiklik oluşmayacaktır.

Bu kadar açıklamadan ve bilgilendirmeden sonra örnek dosyanızı ekleyip yaptığınız işlemi açıklarsanız daha stabil çalışabilecek kodlama tasarlanabilir.

 

[xternet]

Sayın Korhan Ayhan meseleyi özetlemişsiniz. Dediğiniz gibi sorun "toplama kodlar"
Bende fakındayım aslında. Şimdiye kadar hep uyarlama yaparak, kod mantığının özüne inmeden
işlerimi çözmeye çalıştım. Ama bu konuda kendimi geliştirmeden bu iş yürümeyecek gibi.

Örnek dosya demişsiniz ama, her şey o kadar iç içe girmiş ki neresinden örnek oluşturayım bilemedim.
Burada konu ettiğim çalışma, yukarıda bahsettiğim son kod eklenmemiş şekilde şu anda aktif olarak kullanılıyor aslında.

https://www.yavuzkoc.com/?smd_process_download=1&download_id=2136

Buradan indirebilirsiniz.

Tüm desteğiniz için teşekkür ediyorum Sayın Korhan Ayhan.
Fırsat buldukça kendimi yenileme çalışmalarında sizi rahatsız edeceğim inşallah.
İyi çalışmalar diliyorum.

 

[incsoft]

Deneyiniz.

Sub Koruma_Kaldir()
    Dim Parola As Variant, Sayfa As Worksheet
   
    Parola = InputBox("Lütfen sayfa koruma şifresini giriniz!", "ŞİFRE GİRİŞİ")
   
    If Parola = "" Or Parola = False Then
        MsgBox "İşleminiz iptal edilmiştir!", vbExclamation
        Exit Sub
    End If
   
    If Parola <> 12345 Then
        MsgBox "Hatalı şifre girişi yaptınız!" & vbCr & "Lütfen daha sonra tekrar deneyiniz.", vbCritical
        Exit Sub
    Else
        For Each Sayfa In Sheets(Array("Sayfa1", "Sayfa3", "Sayfa5"))
            Sayfa.Unprotect Parola
        Next
       
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
End Sub

Korhan bey ben excel'in sayfa koruma sistemini kullanıyorum ancak kullanan kişiler sayfa korumasını kaldır demeden otomatik olarak korumayı kaldırıyor. Mesela ben sayfaya bu kodu nereye girersem kaldır dediklerinde bu macro uygulanır?

Teşekkürler.