traduction unicode - XL/fichier .txt

[Toutou]

Bonjour le forum,

je m'arache les cheveux sur le parametrage d'un logiciel: l'etape du jour est l'ajout d'une option multilingue...

je vous passe les details.
En bref, j'ai un fichier .txt (php) rediger du type :

"
#infos de bases
log_in = Mon login
mdp= Mon mot de passe
"

Dans un fichier excel, j'ai 2 colonnes sur une meme feuille:
Colonne A: des caracteres de l'alphabet latin et qq symboles.
Colonne B: leur code Unicode hexadecimal

ce que cherche a faire: remplacer une partie du texte du fichier .txt en unicode comme suit:

"
#infos de bases
log_in = Mon login
"

deviendrait:

"
#infos de bases
log_in = \u004c\006F\u006E\u0020\u006C\u006F\u0067\u0069\u006E
"
avec les codes suivants:
M=004C
o=006F
n=006E
=0020
l=006C
o=006F
g=0067
i=0069
n=006E

Cela est-ti possible avec du VBA?

si oui comment?

merci d'avance

bonnejournee

Toutou

 

[mromain]

Re : traduction unicode - XL/fichier .txt

Bonjour Toutou,

Voici un exemple.

Le fichier Excel contient :
> une liste de caractère avec les codes Unicode associés ;
> le code suivante qui modifie le login et le mdp d'un fichier texte.

Option Explicit

Public Sub ModifFichierTxt()
Dim fichierTxt As Object, fichierTmp As Object, monFso As Object
Dim pathFichierTxt As String, pathFichierTmp As String, curLigne As String, motOrig As String, motModif As String


    'définir le chemin du fichier txt (php) à modifier
    pathFichierTxt = "E:\XLS\test\FichierTest.txt"
    
    'ouvrir le fichier txt (en lecture seule
    Set monFso = CreateObject("Scripting.FileSystemObject")
    Set fichierTxt = monFso.OpenTextFile(pathFichierTxt, 1)
    
    'créer un fichier temporaire dans le même répertoire que ce classeur
    pathFichierTmp = ThisWorkbook.Path & "\fichTmp" & Format(Now, "yyyymmdd_hhmm") & ".txt"
    Set fichierTmp = monFso.CreateTextFile(pathFichierTmp, True)
    
    'boucler sur chaque ligne du fichier txt (jusqu'à la fin du fichier)
    While Not fichierTxt.AtEndOfStream
        
        'récupérer la ligne courante
        curLigne = fichierTxt.ReadLine
        
        'si la ligne commence par "log_in = "
        If curLigne Like "log_in = *" Then
            
            'récupérer le login
            motOrig = Replace(curLigne, "log_in = ", "")
            
            'traiter le login (remplacer par les caractère unicode)
            motModif = ModifMot(motOrig)
            
            'remplacer le mot dans la ligne courante
            curLigne = Replace(curLigne, motOrig, motModif)
            
        End If
        
        'si la ligne commence par "mdp= "
        If curLigne Like "mdp= *" Then
            
            'récupérer le mdp
            motOrig = Replace(curLigne, "mdp= ", "")
            
            'traiter le mdp (remplacer par les caractère unicode)
            motModif = ModifMot(motOrig)
            
            'remplacer le mot dans la ligne courante
            curLigne = Replace(curLigne, motOrig, motModif)
            
        End If
        
        'écrire la ligne dans le fichier temporaire
        fichierTmp.WriteLine (curLigne)
        
    Wend
    
    'fermer les fichiers
    fichierTxt.Close: fichierTmp.Close
    
    'suprimer le fichier txt
    monFso.DeleteFile pathFichierTxt, True
    
    'déplacer et renommer le fichier tmp
    monFso.MoveFile pathFichierTmp, pathFichierTxt
    
    'détrure les objets
    Set monFso = Nothing: Set fichierTxt = Nothing: Set fichierTmp = Nothing
    
End Sub



Private Function ModifMot(mot As String) As String
Dim iCar As Long, cellFind As Range, zoneCaractere As Range

    'définir la zone où on va chercher les caractères (colonne B de la feuille Feuil1)
    Set zoneCaractere = ThisWorkbook.Sheets("Feuil1").Range("B:B")
        
    'boucler sur chaque caractère du mot
    For iCar = 1 To Len(mot)
        
        'rechercher la cellule contenant le caractère
        Set cellFind = Nothing
        Set cellFind = zoneCaractere.Find(Mid(mot, iCar, 1), , xlValues, xlWhole)
        
        'si on a bien trouvé la cellule contenant le caractère
        If Not cellFind Is Nothing Then
            'ajouter la valeur unicode au résultat retourné par la fonction et "\"
            ModifMot = ModifMot & "\" & cellFind.Offset(0, -1).Text
        End If
        
    Next iCar
        
End Function

Le path du fichier texte à traiter est à adapter.

a+