Criptografía (CCLXIV): La escítala espartana en Excel

Ya puse una entrada con un script en python para cifrar y descifrar utilizando la escítala espartana.

Y ahora, en este post incluyo el cifrado y descifrado utilizando este mismo criptosistema en Excel. 

Antes de poner el correspondiente código Visual Basic para aplicaciones (VBA), recordar que este cifrado se basa en sendas varas de grosor igual o similar que debían estar en posesión del emisor y del receptor del mensaje secreto, que se escribía en una cinta de cuero enrollada en una de las varas, y después se enviaba la cinta al receptor del mensaje.

El código es el siguiente:

' LA ESCÍTALA ESPARTANA:
'
' Cifra y descifra textos en claro y criptogramas, respectivamente,
' utilizando la escítala espartana.
'
' http://mikelgarcialarragan.blogspot.com/

Option Explicit
Public TEXTO_CLARO As Range
Public GROSOR As Range
Public CRIPTOGRAMA As Range
Public Sub Cifrar()
    Dim Longitud As Integer
    Dim i As Integer
    Dim j As Integer

    Range("TEXTO_CLARO").Value = A_Z(UCase(Replace(Range("TEXTO_CLARO").Value, " ", "")))
    
    If Len(Range("TEXTO_CLARO").Value) = 0 Then
        MsgBox "Introduzca el texto en claro a cifrar. Sólo caracteres alfabéticos [A-Z], 'Ñ' excluida.", vbOKOnly + vbCritical, "¡Error!"
    Else
        If Range("GROSOR").Value < 1 Or Range("GROSOR").Value > 26 Then
            MsgBox "El grosor (número de filas) debe seer un número comprendido entre 1 y 26.", vbOKOnly + vbCritical, "¡Error!"
            Range("GROSOR").Value = 3
        Else
            Range("CRIPTOGRAMA").Value = ""
            If Len(Range("TEXTO_CLARO").Value) Mod Range("GROSOR").Value = 0 Then
                Longitud = Len(Range("TEXTO_CLARO").Value) \ Range("GROSOR").Value
            Else
                Longitud = Len(Range("TEXTO_CLARO").Value) \ Range("GROSOR").Value + 1
            End If
            Range("TEXTO_CLARO").Value = Range("TEXTO_CLARO").Value & Space(Range("GROSOR").Value * Longitud - Len(Range("TEXTO_CLARO").Value))
            j = 1
            For i = 1 To Longitud
                For j = j To Len(Range("TEXTO_CLARO").Value) Step Longitud
                    Range("CRIPTOGRAMA").Value = Range("CRIPTOGRAMA").Value & Mid(Range("TEXTO_CLARO").Value, j, 1)
                Next j
                j = i + 1
            Next i
        End If
    End If

End Sub
Public Sub Descifrar()
    Dim i As Integer
    Dim j As Integer

    Range("CRIPTOGRAMA").Value = A_Z(UCase(Range("CRIPTOGRAMA").Value))
    
    If Len(Range("CRIPTOGRAMA").Value) = 0 Then
        MsgBox "Introduzca el criptograma a descifrar. Sólo caracteres alfabéticos [A-Z], 'Ñ' excluida.", vbOKOnly + vbCritical, "¡Error!"
    Else
        If Range("GROSOR").Value < 1 Or Range("GROSOR").Value > 26 Then
            MsgBox "El grosor (número de filas) debe seer un número comprendido entre 1 y 26.", vbOKOnly + vbCritical, "¡Error!"
            Range("GROSOR").Value = 3
        Else
            Range("TEXTO_CLARO").Value = ""
            j = 1
            For i = 1 To Range("GROSOR").Value
                For j = j To Len(Range("CRIPTOGRAMA").Value) Step Range("GROSOR").Value
                    Range("TEXTO_CLARO").Value = Range("TEXTO_CLARO").Value & Mid(Range("CRIPTOGRAMA").Value, j, 1)
                Next j
                j = i + 1
            Next i
        End If
    End If

End Sub
Function A_Z(Cadena As String) As String
    Dim Caracter As Integer

    For Caracter = 1 To Len(Cadena)
        Select Case Asc(Mid(Cadena, Caracter, 1))
            Case 32, 65 To 90:
                A_Z = A_Z & Mid(Cadena, Caracter, 1)
        End Select
    Next

End Function

Ejemplo de funcionamiento:

- Cifrar:

- Descifrar:

Quizás también te interese: