Code Vigenere VBA

Bonjour à tous,

Je dois effectuer le code Vigenere sur VBA sans utiliser le code ascii. J'ai donc essayer ce programme (ci-dessous) mais aucun résultat ne s'affiche. Il doit sûrement avoir des erreurs dans ce programme mais je n'arrive pas à les résoudre. Pourriez-vous m'aider?

Merci d'avance.

Sub Bouton2_Cliquer()

   alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

   Phrase = Cells(1, 2).Value
   Clé = Cells(2, 2).Value

   Lenphrase = Len(Phrase)
   Lenclé = Len(Clé)

   Position = 1

For i = 1 To Lenphrase

       lettre1 = Mid(Phrase, Position, 1)
       lettre2 = Mid(Clé, ((Position - 1) Mod Len(Clé)) + 1, 1)

       Positionphrase = InStr(1, alpha, lettre1)
       Positionclé = InStr(1, alpha, lettre2)

       decalage = Positionphrase + Positonclé - 1
       decalage = (decalage - 1) Mod 26 + 1

       lettrecode = Mid(alpha, decalage, 1)
       code = code & lettrecode
       Position = Position + 1
Next

MsgBox code

End Sub

Bonjour,

intéressant en effet

... as-tu un bout de fichier excel ?

Bonjour,

pour commencer, il faut s'assurer que votre phrase ne contient que des majuscule non accentués au vu de votre code alpha="ABCDEFGHIJKLMNOPQRSTUVWXYZ"

en suite une phrase a des "espaces", donc il faut ajouter ce caractère dans alpha,

Et il faut aussi gérer le cas particulier du A, car à ce moment là il n'y a pas de décalage, et Mid(alpha,decalge,1)

avec decalage = 0, ce n'est pas bon.

Bonne continuation

@ bientôt

LouReeD

Bonjour LouReeD

LouReeD a écrit :

Et il faut aussi gérer le cas particulier du A, car à ce moment là il n'y a pas de décalage, et Mid(alpha,decalge,1)

Voici le fichier

regarde si c'est ceci que tu attends !

Sub Bouton2_Cliquer()

   alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "

   Phrase = Cells(1, 2).Value
   cle = Cells(2, 2).Value

   Lenphrase = Len(Phrase)
   Lencle = Len(cle)

   Position = 1

   For i = 1 To Lenphrase
   If Mid(Phrase, Position, 1) <> " " Then
       lettre1 = Mid(Phrase, Position, 1)
       lettre2 = Mid(cle, ((Position - 1) Mod Lencle) + 1, 1)

       Positionphrase = InStr(1, alpha, lettre1)
       Positioncle = InStr(1, cle, lettre2)

       decalage = Positionphrase + Positoncle
       decalage = (decalage - 1) Mod 26 + 1

       lettrecode = Mid(cle, decalage, 1)
       code = code & lettrecode
    Else
        code = code & " "
    End If
    Position = Position + 1

Next

Call MsgBox(code)

End Sub

Compare les codes car j'ai fait plusieurs modifications et je ne sais plus lesquelles !!

Le A plantait en effet à cause d'un -1

Maintenant, je ne sais pas si c'est le plus logique, ni si c'est le résultat recherché mais il y a un résultat !

Il faudra encore travailler la fonction car AAAAA donne 5 fois le même caractère !

Je viens de tester le programme mais le problème c'est qu'aucune réponse s'affiche. Il y a une petite erreur sur le décalage où il y a écrit positon et non position. Par exemple, si je veux coder le mot BATEAU avec comme clé RIZ je devrais obtenir le mot SISVIT or ici je n'obtiens rien.

NON

tu mets toi-même dans ton programme que les informations sont en colonne 2 !!!!

   Phrase = Cells(1, 2).Value
   cle = Cells(2, 2).Value

Désolé mes réponses ne sont pas assez rapide, je donne une réflexion sur le AAAA :

Normalement avec ce type de codage avec un clé, chaque lettre se retrouve avec un codage différent :

lettre A d'origine (position 1 dans l'alphabet)

lettre L de clé c'est LOUREED bien évidemment, 12 au niveau de l'alphabet

1 + 12 = 13 on code un M

deuxième lettre d'origine on retrouve un A = 1

deuxième lettre de la clé on trouve un O = 15

15+1 = 16 on code un P

donc AA = MP !

Décodage :

on trouve un M=13, on retranche la valeur de la clé Qui est un L = 12 = 1 on retrouve le A

etc...

L'idéale est d'avoir une clé aléatoire au niveau de sa composition et de même longueur que la phrase...

L'inconvénient, la clé est connu du codeur et du décodeur, ce qui double les risque de fuite.

@ bientôt

LouReeD

Une modif pour en effet corriger ceci

LouReeD a écrit :

sur le AAAA :

Normalement avec ce type de codage avec un clé, chaque lettre se retrouve avec un codage différent :

C'est déjà mieux ... mais pas encore cela !

Sub Bouton2_Cliquer()

    alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

    Phrase = Cells(1, 2).Value
    Cle = Cells(2, 2).Value

    Lenphrase = Len(Phrase)
    Lencle = Len(Cle)

    For i = 1 To Lenphrase
        If Mid(Phrase, i, 1) <> " " Then

            lettre1 = Mid(Phrase, i, 1)
            lettre2 = Mid(Cle, ((i - 1) Mod Lencle) + 1, 1)

            Positionphrase = InStr(1, alpha, lettre1)
            Positioncle = InStr(1, Cle, lettre2)

            decalage = Positionphrase + Positoncle + i
            decalage = (decalage - 1) Mod 26 + 1

            lettrecode = Mid(Cle, decalage, 1)
            code = code & lettrecode

        Else
            code = code & " "
        End If
    Next

    MsgBox (code)

End Sub

je regarderai ce soir ... mais LouReeD tu peux poursuivre de ton côté bien sûr ! Il faut que j'aille travailler un peu !!

Après le test de vos différentes idées, aucune n'a véritablement marché. Il y a toujours le problème d'affichage dans MessageBox (cette fois-ci j'ai bien mis dans la colonne 2). Dans l'avant dernier programme seule une lettre s'affiche et dans le dernier rien ne s'affiche

Voilà une proposition qui ne répéte pas les A !

Sub test()
    Dim alpha As String, la_phrase, la_clé, index_P, index_C
    Dim i, lettre As String, clé As String, pos_l, pos_c, Nouv
    Dim Sortie As String
    alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
    la_phrase = UCase(Cells(1, 1))
    la_clé = UCase(Cells(2, 1))
    index_P = 1
    index_C = 1
    For i = 1 To Len(la_phrase)
        lettre = Mid(la_phrase, index_P, 1)
        clé = Mid(la_clé, index_C, 1)
        pos_l = InStr(alpha, lettre)
        pos_c = InStr(alpha, clé)
        Nouv = pos_l + pos_c
        If Nouv > 27 Then Nouv = Nouv - 27
        Sortie = Sortie & Mid(alpha, Nouv, 1)
        index_P = index_P + 1
        If index_P > Len(la_phrase) Then index_P = 1
        index_C = index_C + 1
        If index_C > Len(la_clé) Then index_C = 1
    Next i
    MsgBox (Sortie)
End Sub

Je ne traite pas l'espace comme un caractère à part, ce qui donne un codage avec une découpe visuelle qui peut être différente de la phrase d'origine...

@ bientôt

LouReeD

Pour ma part en respectant la longueur de chaque mot

Sub crypter()
    alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Phrase = Cells(1, 2).Value
    cle = Cells(2, 2).Value
    Lenphrase = Len(Phrase)
    lencle = Len(cle)
    code = ""
    For i = 1 To Lenphrase
        If Mid(Phrase, i, 1) <> " " Then
            code = code & Mid(alpha, (InStr(1, alpha, Mid(Phrase, i, 1)) + InStr(1, alpha, Mid(cle, (i - 1) Mod lencle + 1, 1)) - 1) Mod 26, 1)
        Else
            code = code & " "
        End If
    Next
    MsgBox (code)
End Sub

Roro9876543210 a écrit :

si je veux coder le mot BATEAU avec comme clé RIZ je devrais obtenir le mot SISVIT

une peu plus détaillé si tu veux ...

Sub crypter()
    alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Phrase = UCase(Cells(1, 2).Value)
    Cle = UCase(Cells(2, 2).Value)
    LenPhrase = Len(Phrase)
    LenCle = Len(Cle)
    code = ""
    For i = 1 To LenPhrase
        If Mid(Phrase, i, 1) <> " " Then
            lettre1 = Mid(Phrase, i, 1)
            pos1 = InStr(1, alpha, lettre1)
            lettre2 = Mid(Cle, (i - 1) Mod LenCle + 1, 1)
            pos2 = InStr(1, alpha, lettre2)
            code = code & Mid(alpha, (pos1 + pos2 - 1) Mod 26, 1)
        Else
            code = code & " "
        End If
    Next
    MsgBox (code)
End Sub

Merci Beaucoup Steelson pour votre aide. Le dernier programme fonctionne à merveille. Je vous en remercie.

As-tu besoin de la réversibilité ?

Plus important ... as-tu compris ce qui clochait dans ton programme initial ?

Je n'ai pas besoin de la réversibilité et pour ce qui est de la compréhension, j'ai compris globalement mais il y a surtout la ligne avec code que j'ai un peu moins compris mais je vais essayer d'étudier cela.

Une correction

code = code & Mid(alpha, (pos1 + pos2 - 2) Mod 26 + 1, 1)

UWLDIFV CV MV ORA MWTCWHI CVKQPXSVZ (code RIZ)

Sub crypter()
    alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Phrase = UCase(Cells(1, 2).Value)
    Cle = UCase(Cells(2, 2).Value)
    LenPhrase = Len(Phrase)
    LenCle = Len(Cle)
    code = ""
    For i = 1 To LenPhrase
        If Mid(Phrase, i, 1) <> " " Then
            lettre1 = Mid(Phrase, i, 1)
            pos1 = InStr(1, alpha, lettre1)
            lettre2 = Mid(Cle, (i - 1) Mod LenCle + 1, 1)
            pos2 = InStr(1, alpha, lettre2)
            code = code & Mid(alpha, (pos1 + pos2 - 2) Mod 26 + 1, 1)
        Else
            code = code & " "
        End If
    Next
    Cells(3, 2).Value = code
End Sub

Sub decrypter()
    alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Phrase = UCase(Cells(3, 2).Value)
    Cle = UCase(Cells(2, 2).Value)
    LenPhrase = Len(Phrase)
    LenCle = Len(Cle)
    code = ""
    For i = 1 To LenPhrase
        If Mid(Phrase, i, 1) <> " " Then
            lettre1 = Mid(Phrase, i, 1)
            pos1 = InStr(1, alpha, lettre1)
            lettre2 = Mid(Cle, (i - 1) Mod LenCle + 1, 1)
            pos2 = InStr(1, alpha, lettre2)
            code = code & Mid(alpha, pos1 - pos2 + 1 + IIf(pos1 - pos2 + 1 < 0, 26, 0), 1)
        Else
            code = code & " "
        End If
    Next
    Cells(4, 2).Value = code
End Sub