Şifreli Yazı

hakki83

Altın Üye
Katılım
30 Eylül 2021
Mesajlar
533
Excel Vers. ve Dili
Excel 2016 Türkçe 32 Bit
Altın Üyelik Bitiş Tarihi
30-09-2026
Selamlar

Bir çalışma yapmak istedim.
Konu: Şifreli Yazı

İki kişi arasında aynı dosya mevcut olacak.

İlk önce, bilgisayar klavyesindeki görünen harflere, karıştırılmış harfler tayin edileceK (Sayfa1).

Birbirlerine gönderecekleri mesajı; bu excel dosyası ile şifreli hale getirecekler (Sayfa2).


Birbirlerinden gelen şifreli mesajı bu excel dosyası ile okunur hale getirecekler (Sayfa3).

Tabi bunun gibi farklı onlarca çeşit dosya yapılabilir. İlk aklıma geleni yaptım.

Böyle bir dosya için kod oluşturabilir miyiz?
 

Ekli dosyalar

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,605
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
Merhaba,
"Tabi bunun gibi farklı onlarca çeşit dosya yapılabilir. " sözünüze katılıyorum. Bu çok basit ve yetersiz. Aşağıdaki kodlar, örnek dosyanız esas alınarak yazılmıştır. Lütfen örnek dosyanıza uygulayınız. ("HARFLERİN KARŞILIKLARI" isimli sayfanızdaki karakterleri dikkate alır, klavyedeki diğer karakterleri tanımaz.)
ŞİFRELİ MESAJ YAZMA sayfanızdaki CommandButton için:
Kod:
Private Sub CommandButton1_Click()
s2 = Sheets("ŞİFRELİ MESAJ YAZMA").Cells(2, 1)
Uzunluk = Len(s2)
For i = 1 To Uzunluk
    Aranan = Mid(s2, i, 1)
    With Sheets("HARFLERİN KARŞILIKLARI").Range("A2:A66")
        Set c = .Find(Aranan, LookIn:=xlValues, MatchCase:=True)
        If Not c Is Nothing Then
            Sifreli = Sifreli + .Cells(c.Row - 1, 2)
        End If
    End With
Next
  Sheets("ŞİFRELİ MESAJ YAZMA").Cells(2, 2) = Sifreli
End Sub
ŞİFRELENMİŞ MESAJI ÇÖZME sayfanızdaki CommandButton için:
Kod:
Private Sub CommandButton1_Click()
s2 = Sheets("ŞİFRELENMİŞ MESAJI ÇÖZME").Cells(2, 1)
Uzunluk = Len(s2)
For i = 1 To Uzunluk
    Aranan = Mid(s2, i, 1)
    With Sheets("HARFLERİN KARŞILIKLARI").Range("B2:B66")
        Set c = .Find(Aranan, LookIn:=xlValues, MatchCase:=True)
        If Not c Is Nothing Then
            Sifreli = Sifreli + .Cells(c.Row - 1, c.Column - 2)
        End If
    End With
Next
  Sheets("ŞİFRELENMİŞ MESAJI ÇÖZME").Cells(2, 2) = Sifreli
End Sub
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Sitede "kriptoloji" terimini aratabilirsiniz...

.
 

hakki83

Altın Üye
Katılım
30 Eylül 2021
Mesajlar
533
Excel Vers. ve Dili
Excel 2016 Türkçe 32 Bit
Altın Üyelik Bitiş Tarihi
30-09-2026
Sağ olunuz değerli hocalarımız. Dede hocam çok güzel olmuş, emeğinize sağlık.
 
Üst