crypter des mots

[bansan]

Bonjour
Bien que cela soit un forum pour excel
je me permets de vous demander si vous n'aureiz pas des notions du VBA mais de word

J'aimerais faire la mcro suivante:

Je dispose d'un texte que j'aimerai crypté en changeant chaque lettre de chaque mot par la lettre suivante de l'ordre de l'alphabet

Donc en bref ,
Si j'ai une phrase telle que: je suis fou en activant ma macro, elle se changera en: kl tvjt gpv

Les espaces restent des espaces

Merci beaucou^p

 

[Staple1600]

Re : crypter des mots

Bonjour



Un petit exemple

Copie ce code dans un module
et lance la macro testC_D

Public Function crypt_bansan(S As String)
Dim i As Integer
Dim L As String
Dim c_mot As String
Dim nv_car As Integer
For i = 1 To Len(S)
  L = Mid(S, i, 1)
  nv_car = Asc(L) + 1
  c_mot = c_mot & Chr(nv_car)
Next i
crypt_bansan = c_mot
End Function

Public Function decrypt_bansan(S As String)
Dim i As Integer
Dim L As String
Dim dc_mot As String
Dim nv_car As Integer
For i = 1 To Len(S)
  L = Mid(S, i, 1)
  nv_car = Asc(L) - 1
  dc_mot = dc_mot & Chr(nv_car)
Next i
decrypt_bansan = dc_mot
End Function

Sub testC_D()
Dim strg As String
Dim cstrg As String
Dim dcstrg As String
strg = "[B]je suis fou[/B]" 'c'est toi qui le dit ;)
cstrg = crypt_bansan(strg)
MsgBox cstrg
dcstrg = decrypt_bansan(cstrg)
MsgBox dcstrg
End Sub

Il te reste plus qu'a adapter pour Word

 

[bansan]

Re : crypter des mots

Merci bien JM
Je pensais que j'aurais pu utiliser cette macro dans un texte que je selectionne...
Imaginons que j'ai un document word et j'aimerais le crypter.., donc je le selectionne et je lance la macro....

Ct + dans ce genre là que je voyais la chose...
Mais c'est deja une idée le code que tu m'as donné

Merci

 

[Staple1600]

Re : crypter des mots

Re

Voici une première ébauche

(A tester dans Word)

Test OK sur une seule phrase sélectionnée

Sub crypte()
Dim Doc_Range As Range
Dim i As Long
Set Doc_Range = Selection.Range
For i = 1 To Doc_Range.Characters.Count
Doc_Range.Characters(i).Text = Chr$(Asc(Doc_Range.Characters(i).Text) + 1)
Next i
End Sub
Sub decrypte()
Dim Doc_Range As Range
Dim i As Long
Set Doc_Range = Selection.Range
For i = 1 To Doc_Range.Characters.Count
Doc_Range.Characters(i).Text = Chr$(Asc(Doc_Range.Characters(i).Text) - 1)
Next i
End Sub

Tu veux crypter la sélection ou un fichier Word non ouvert?

PS: Théoriquement, dans Word 2000, dans les options, on peut
choisir d'encrypter le document (avec mot de passe) et sélection de la méthode de chiffrement.

 

[Staple1600]

Re : crypter des mots

Re


Voici un essai dans un fichier Word

Cliquez sur les boutons adéquats.

PS: si un VBAiste passe par ici, peut-il me dire pourquoi le code est long à s'éxécuter ?

Merci.

 

[bansan]

Re : crypter des mots

Bonjour
Merci pour ces lignes de code, je teste ça dans un moment

merci beaucoup

 

[bansan]

Re : crypter des mots

Re
Le macro est desactivé a priori,
Comment faire pour l'activer??
Merci

 

[jeanpierre]

Re : crypter des mots

Bonjour,

Menu Outils/Macro/Sécurité et cocher Moyen.

A l'ouverture du fichier, il te faudra activer les macros.

Bonne journée.

Jean-Pierre

 

[bansan]

Re : crypter des mots

Re..J'ai bien mis "Securité moyenne"...mais ca ne marche toujours pas...
"Lactivation des macros de ce projet sont desactivés , referez vous a l'aide...."
Une idée..??
Je recherche sur le forum

Merci beaucoup

 

[bansan]

Re : crypter des mots

Je suis avec office 2007 et je viens d'essayer avec 2003..marche toujours pas...

 

[jeanpierre]

Re : crypter des mots

Re,

Sur 2007 ok, mais sous 2003, je ne comprends pas.

Fais une recherche (en haut à droite) sur le forum 2007. Recherche/Recherche avancée avec pour recherche : sécurité macro 2007 et pour le contributeur : MichelXLD

Je crois qu'il a abordé ce sujet.

Je n'ai pas le temps maintenant, plus en fin d'après-midi, je verrai de mon côté.

 

[Staple1600]

Re : crypter des mots

Bonjour bansan, jeanpierre, le forum

bansan: pour infos, le fichier Word a été fait sous Word 2000, la macro fonctionne (mais est lente), même sur peu de paragraphes.

PS: tu pourrais aussi envisager de mettre un mot de passe sur le fichier
(ce qui serait plus simple)

PS2: si un VBAIste pouvait jeter un oeil sur le code, merci. Car je connais mal
VBA sous Word.

 

[Staple1600]

Re : crypter des mots

Bonsoir le fil, le forum


Voici une autre proposition

(test OK sur Word 2000)
Copier le code VBA, dans un module d'un document Word vierge.
(pas dans normal.dot)

Pour tester
Dans un document vierge
sur la première ligne, saisir:
=rand(10,10)

Puis Outils/Macros/ -sélectionner rot13
puis cliquez sur [Exécuter]

Pour remettre le texte dans son état initial
Relancer une deuxième fois rot13

Sub rot13()
Dim myRange As Range
'auteur: Christian Freßdorf
Const l As String = "abcdefghijklmnopqrstuvwxyz"
Application.ScreenUpdating = False
'Falcultatif : désactive la vérification orthographique
'Options.CheckSpellingAsYouType = False
Set aDoc = ActiveDocument
Set myRange = _
aDoc.Range(aDoc.Paragraphs(1).Range.Start, _
aDoc.Paragraphs(aDoc.Paragraphs.Count).Range.End)
myRange.Font.Color = wdColorBlack
Do_rot myRange, l
Do_rot myRange, UCase(l)
myRange.Font.Color = wdColorBlack
Application.ScreenUpdating = True
End Sub

Function Do_rot(rng As Range, str As String)
Dim r As Range
Dim iTemp As Integer, sTEmp As String
Dim i As Integer
For i = 1 To Len(str)
  Set r = rng
  With r.Find
    .Text = Mid(str, i, 1)
    .Font.Color = wdColorBlack
    iTemp = (i + 13) Mod Len(str)
    If iTemp = 0 Then iTemp = Len(str)
    sTEmp = Mid(str, iTemp, 1)
    .Replacement.Text = sTEmp
    .Replacement.Font.Color = wdColorRed
    .MatchCase = True
    .Execute Replace:=wdReplaceAll
  End With
Next i
End Function

source

 

[bansan]

Re : crypter des mots

Bonjour JM et merci pour ce code qui marche
Une petite question:
Faut t'il toujours ecrire (rand...) que la macro fonctionne par la suite??

Est til possible que son mode de cryptage soit (+1 lettre) c'est a dire que "a" est remplacé par "b", "b" par "c"....ect...

Merci cependant pour ce fameux code, il marche

Merci bcp

 

[Staple1600]

Re : crypter des mots

Bonjour


Non

=rand(5,5) permet de générer du texte aléatoire (utile pour faire des tests)

(tu peux mettre les chiffres que tu veux à la place du 5 évidemment)

(donc évite d'avoir à saisir du texte)

Si c'est vraiment ce que tu veux

Essaye de remplacer

 iTemp = (i + 13) Mod Len(str)

par

 iTemp = (i + 1) Mod Len(str)