Snasui Excel Forum

Code: Select all

Public Sub Crypto01()
    Dim Key As String, PlainText As String, tempText As String
    Dim Longkey As String, Encode As String, Decode As String
    Dim t As String, i As Integer
    Key = InputBox("Enter the key of encryption")
    Key = UCase(Key)
    tempText = InputBox("Enter the message that you want to send")
    PlainText = Replace(tempText, " ", "")
    Longkey = Left(Application.Rept(Key, 10), Len(PlainText))
    Encode = ""
    For i = 1 To Len(Longkey)
        With Sheets("Sheet1").Application
            t = .Index(.Range("A2:Z27") _
                , .Match(Mid(PlainText, i, 1), .Range("A2:A27"), 0) _
                , .Match(Mid(Longkey, i, 1), .Range("A1:Z1"), 0))
        End With
        Encode = Encode & t
    Next i
    Decode = Application.Replace(Encode, InStr(tempText, " "), 0, "_")
    MsgBox Encode
    MsgBox Decode
End Sub

Code: Select all

Option Explicit
Public Sub Crypto()

Dim Key As String, Message As String, PlainText As String, Longkey As String, encode As String, _
      Decode As String, EnCol As String, EnRow As String
Dim i As Integer, p As Integer, r As Integer, c As Integer
    
Key = InputBox("Enter the key of encryption") 
Key = UCase(Key) 
Message = InputBox("Enter the message that you want to send")
Message = LCase(Message)
PlainText = Replace(Message, " ", "")
Longkey = Left(Application.WorksheetFunction.Rept(Key, 10), Len(PlainText))
MsgBox ("Key = " & Key) 
Worksheets("Sheet1").Range("B29").Value = Key
MsgBox ("Message = " & Message) ' show message
Worksheets("Sheet1").Range("B30").Value = Message 
MsgBox ("PlainText = " & PlainText) ' show Plaintext
Worksheets(Sheet1").Range("B31").Value = PlainText  
MsgBox ("Longkey = " & Longkey) ' show long key
Worksheets("Sheet1").Range("B32").Value = Longkey

p = 1
For i = 1 To Len(Message)   
        EnCol = Mid(Message, i, 1) 
            If EnCol = " " Then 
                encode = encode + " "
                p = p - 1
            Else
                EnRow = Mid(Longkey, p, 1)
                r = Application.Match(EnRow, Range("A2:A27"), 0)
                r = r + 1 
                c = Application.Match(EnCol, Range("A1:Z1"), 0) 
        encode = encode + Worksheets("Crypto").Cells(r, c).Value 
        End If
        p = p + 1
Next i
Worksheets("Crypto").Range("b33").Value = encode 
MsgBox ("Encode = " & encode) 

p = 1
For i = 1 To Len(Message) 
        EnCol = Mid(encode, i, 1)
            If EnCol = " " Then 
                Decode = Decode + " "
                p = p - 1
            Else
                EnRow = Mid(Longkey, p, 1) 
                r = Application.Match(EnRow, Range("A2:A27"), 0) 
                r = r + 1 'Not Found row A1
                c = Application.Match(EnCol, Range(Cells(r, 1), Cells(r, 26)), 0) 
        Decode = Decode + Worksheets("Crypto").Cells(1, c).Value  
        End If
        p = p + 1
Next i
Worksheets("Crypto").Range("b34").Value = Decode 
MsgBox ("Decode = " & Decode) 

MsgBox ("Formatting has been applied")
Range("B29:B34").ClearContents
Range("B29:B34").Style = "Normal"
MsgBox ("Original formatting")
End Sub

Code: Select all

Public Sub Crypto()
    ''''''''''''''''''''''''''''' Declarations variable'''''''''''''''''''''''''''''''''''''''
    Dim Key As String, Message As String, PlainText As String, Longkey As String
    Dim encode As String, Decode As String, EnCol As String, EnRow As String
    Dim i As Integer, p As Integer, r As Integer, c As Integer
    Dim l As Integer, a(1 To 26, 1 To 26) As Variant, ta As Variant, tb(1 To 26) As Variant
    Dim m As Integer, t As String, n As Integer, o As Integer
    ta = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", _
        "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
    t = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    t = Application.Rept(t, 2)
    For l = 1 To 26
        For m = 1 To 26
            a(l, m) = Mid(t, m + n, 1)
        Next m
        n = n + 1
    Next l
    Key = InputBox("Enter the key of encryption") ' get Key
    Key = UCase(Key)  ' change all key to uppercase letters
    Message = InputBox("Enter the message that you want to send") ' get Message
    Message = LCase(Message) ' change all message to lowercase letter
    PlainText = Replace(Message, " ", "") ' cut space in Message by replacement and put into variable(Plaintext)
    Longkey = Left(Application.WorksheetFunction.Rept(Key, 10), Len(PlainText)) ' cut letter from left of Right_plaintext
    MsgBox ("Key = " & Key)  ' show key
    Worksheets("Crypto").Range("B29").Value = Key 'Set the value to the cell of the range"B29"
    MsgBox ("Message = " & Message) ' show message
    Worksheets("Crypto").Range("B30").Value = Message 'Set the value to the cell of the range"B30"
    MsgBox ("PlainText = " & PlainText) ' show Plaintext
    Worksheets("Crypto").Range("B31").Value = PlainText  'Set the value to the cell of the range"B30"
    MsgBox ("Longkey = " & Longkey) ' show long key
    Worksheets("Crypto").Range("B32").Value = Longkey 'Set the value to the cell of the range"B31"
    
    ''''''''''''''''''''''''''''''''' Encode ''''''''''''''''''''''''''''''''''''''''''''''
    p = 1
    For i = 1 To Len(Message)     ' Loop for Encode
        EnCol = Mid(Message, i, 1) ' Sub Message
        If EnCol = " " Then  ' Check if Sub Message equal space Add space to encode
            encode = encode + " "
            p = p - 1
        Else
            EnRow = Mid(Longkey, p, 1) ' Sub Longkey
            r = Application.Match(EnRow, ta, 0) 'find EnRow in column A return Index
            r = r + 1  'Not Found row A1
            c = Application.Match(EnCol, ta, 0) 'find EnCol in row And return Index
        encode = encode + a(r - 1, c) 'return the value to the cell
        End If
        p = p + 1
    Next i
    Worksheets("Crypto").Range("b33").Value = encode 'Set the value to the cell of the range"B33"
    MsgBox ("Encode = " & encode) ' show Encode
    '''''''''''''''''''''''''''''''''''''''''''Decode''''''''''''''''''''''''''''''''
    p = 1
    For i = 1 To Len(Message) ' Loop for Encode
        EnCol = Mid(encode, i, 1) ' Sub Encode
        If EnCol = " " Then ' Check if Sub Encol equal space Add space to encode
            Decode = Decode + " "
            p = p - 1
        Else
            EnRow = Mid(Longkey, p, 1) ' Sub Longkey
            r = Application.Match(EnRow, ta, 0) 'find EnRow in column A return Index
            r = r + 1 'Not Found row A1
            For o = 1 To 26
                tb(o) = a(r, o)
            Next o
            c = Application.Match(EnCol, tb, 0) + 1 'find Encol in row
            Decode = Decode + a(1, c)
        End If
        p = p + 1
    Next i
    Worksheets("Crypto").Range("b34").Value = LCase(Decode) 'Set the value to the cell of the range"B34"
    MsgBox ("Decode = " & Decode) ' show Decode
    'Restore the original style.("Normal" is a name for the default style.)
    MsgBox ("Formatting has been applied")
    Range("B29:B34").ClearContents
    Range("B29:B34").Style = "Normal"
    MsgBox ("Original formatting")
End Sub