Modifier encodage fichier txt ( UTF8 en ANSI ) en VBA

Signaler
Messages postés
2
Date d'inscription
mardi 29 mai 2012
Statut
Membre
Dernière intervention
29 mai 2012
-
Messages postés
172
Date d'inscription
jeudi 8 décembre 2011
Statut
Membre
Dernière intervention
21 juillet 2013
-
Bonjour,

je ne connais pas VB6. J'ai un code VBA qui appartient à une macro BO et je dois le faire évoluer.

Cette macro Bo exporte les données d'états BO dans un fichier texte. Ce fichier texte est encodé UTF-8.

J'ai besoin de modifier l'encodage de ce fichier texte pour de l'ANSI. j'ai adapté le script suivant mais ca plante sur la ligne en gras.

pourriez-vous m'aider, SVP?


Sub ModifEncodage(ByVal file_source As String, ByVal file_destination As String)

Const ForReading 1, ForWriting 2, ForAppending = 8
Const ModeAscii 0, ModeUnicode -1
Dim fso, f_in, f_out

Set fso = CreateObject("Scripting.FileSystemObject")

Set f_in = fso.openTextFile(file_source, ForReading, , ModeUnicode)
Set f_out = fso.openTextFile(file_destination, ForWriting, True, ModeAscii)
Dim Line() As Byte

Do Until f_in.AtEndOfStream
Line = StrConvf_in.readline,vbFromUnicode)
f_out.writeline Line
Loop
f_in.Close
f_out.Close

End Sub


ensuite, je n'ai pas encore codé mais il faut que je supprime f_in et renomme f_out en f_in.

merci d'avance.

5 réponses

Messages postés
172
Date d'inscription
jeudi 8 décembre 2011
Statut
Membre
Dernière intervention
21 juillet 2013
2
Le code d'ucfoutu est complet, il m'aurait bien servi il y a quelques temps ...

Pour un besoin de modifier des infos de fichiers PVR, j'ai créé ceci convenant bien aux caractères français :
Function Utxt(ByVal S As String) As String
    For N = 1 To Len(S)
         C = Mid(S, N, 1)
         A = Asc(C)
         If A > 169 Then C = "Ã" & Chr(A - 64)
         Utxt = Utxt & C
    Next
End Function


Function Wtxt(ByVal S As String) As String
    L = Len(S)

    For N = 1 To L
         C = Mid(S, N, 1)

         If C = "Ã" And N < L Then
             A = Asc(Mid(S, N + 1))

             If A > 105 And A < 192 Then
                C = Chr(A + 64)
                N = N + 1
             End If
         End If

         Wtxt = Wtxt & C
    Next
End Function

La fonction Utxt convertit un texte Windows, la fonction Wtxt convertit un texte UTF, si cela peut aider ...
___________________________________________________________________________________________________________________
Comme la vitesse de la lumière est supérieure à celle du son, certains ont l'air brillant avant d'avoir l'air con !

Bonjour,

Désolé, mais la ligne en gras a disparu. Pour faciliter la lecture du code, il est demandé et même très apprécié de mettre le code en forme. C'est avec la troisième icône à partir de la gauche.
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
227
Bonjour,
1) Déclarer des constantes au sein d'une procédure est assez (pour le moins) surprenant (mais ça passe).
2) cette ligne de code est totalement incompréhensible :
Line = StrConvf_in.readline,vbFromUnicode) 

Qu'est-elle donc supposée faire, selon toi ?
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
227
Bon ...
Je suppose que tu voulais appliquer la fonction StrConv à un texte (sans même respecter la syntaxe d'une fonction !)
Cela ne te mènerait pas vraiment loin, de toutes manières.
J'ai ressorti de mes vieux tiroirs un petit bout de code pour les barbares.
Essaye de voir ce qu'il fait (tant dans un sens que dans l'autre).
Le voici :
Option Explicit
Private Sub CommandButton1_Click()
   Dim toto As String, titi As String
    toto = "Notre texte de départ, écrit comme chez nous, c'est à dire comme ça "
    MsgBox "voilà notre texte de départ" & vbCrLf & toto
    titi = en_uft8(toto)
    MsgBox "voilà comment l'a torturé Monsieur UFR8" & vbCrLf & titi
    MsgBox " voilà comment on corrige titi pour le rendre ""buvable""" & vbCrLf & en_comme_chez_soi(titi)
End Sub

 
Private Function en_uft8(texte) As String
    Dim c As Integer, i As Integer, texte_uft8 As String
    texte_uft8 = ""
    i = 1
    Do While i <= Len(texte)
        c = AscW(Mid(texte, i, 1))
        If c < 128 Then
            texte_uft8 = texte_uft8 + Chr(c)
        ElseIf ((c >= 128) And (c < 2048)) Then
            texte_uft8 = texte_uft8 + Chr(((c \ 64) Or 192))
            texte_uft8 = texte_uft8 + Chr(((c And 63) Or 128))
        ElseIf ((c >= 2048) And (c < 65536)) Then
            texte_uft8 = texte_uft8 + Chr(((c \ 4096) Or 224))
            texte_uft8 = texte_uft8 + Chr((((c \ 64) And 63) Or 128))
            texte_uft8 = texte_uft8 + Chr(((c And 63) Or 128))
        Else
            texte_uft8 = texte_uft8 + Chr(((c \ 262144) Or 240))
            texte_uft8 = texte_uft8 + Chr(((((c \ 4096) And 63)) Or 128))
            texte_uft8 = texte_uft8 + Chr((((c \ 64) And 63) Or 128))
            texte_uft8 = texte_uft8 + Chr(((c And 63) Or 128))
        End If
        i = i + 1
    Loop
    en_uft8 = texte_uft8
End Function
 

Private Function en_comme_chez_soi(texte)
    Dim ou1 As Integer, ou2 As Integer, ou3 As Integer, ou4 As Integer, ahah As String, i As Integer
    If si_barbare(texte) = False Then
        en_comme_chez_soi = texte: Exit Function
    End If
    ahah = ""
    i = 1
    Do While i <= Len(texte)
        ou1 = Asc(Mid(texte, i, 1))
        If i <= Len(texte) - 1 Then
            ou2 = Asc(Mid(texte, i + 1, 1))
        Else
            ou2 = 0
        End If
        If i <= Len(texte) - 2 Then
            ou3 = Asc(Mid(texte, i + 2, 1))
        Else
            ou3 = 0
        End If
        If i <= Len(texte) - 3 Then
            ou4 = Asc(Mid(texte, i + 3, 1))
        Else
            ou4 = 0
        End If
        If (ou1 And 240) 240 And (ou2 And 128) 128 And (ou3 And 128) = 128 And (ou4 And 128) = 128 Then
            ahah = ahah + ChrW((ou1 - 240) * 65536 + (ou2 - 128) * 4096) + (ou3 - 128) * 64 + (ou4 - 128)
            i = i + 4
        ElseIf (ou1 And 224) 224 And (ou2 And 128) 128 And (ou3 And 128) = 128 Then
            ahah = ahah + ChrW((ou1 - 224) * 4096 + (ou2 - 128) * 64 + (ou3 - 128))
            i = i + 3
        ElseIf (ou1 And 192) 192 And (ou2 And 128) 128 Then
            ahah = ahah + ChrW((ou1 - 192) * 64 + (ou2 - 128))
            i = i + 2
        ElseIf (ou1 And 128) = 128 Then
            ahah = ahah + ChrW(ou1 And 127)
            i = i + 1
        Else
            ahah = ahah + ChrW(ou1)
            i = i + 1
        End If
    Loop
    en_comme_chez_soi = ahah
End Function

Private Function si_barbare(texte)
    Dim ou1 As Integer, ou2 As Integer, ou3 As Integer, ou4 As Integer, i As Integer
    si_barbare = True
    i = 1
    Do While i <= Len(texte)
        ou1 = Asc(Mid(texte, i, 1))
        If i <= Len(texte) - 1 Then
            ou2 = Asc(Mid(texte, i + 1, 1))
        Else
            ou2 = 0
        End If
        If i <= Len(texte) - 2 Then
            ou3 = Asc(Mid(texte, i + 2, 1))
        Else
            ou3 = 0
        End If
        If i <= Len(texte) - 3 Then
            ou4 = Asc(Mid(texte, i + 3, 1))
        Else
            ou4 = 0
        End If
         
        If (ou1 And 240) = 240 Then
            If (ou2 And 128) 128 And (ou3 And 128) 128 And (ou4 And 128) = 128 Then
                i = i + 4
            Else
                si_barbare = False: Exit Function
            End If
        ElseIf (ou1 And 224) = 224 Then
            If (ou2 And 128) 128 And (ou3 And 128) 128 Then
                i = i + 3
            Else
                si_barbare = False: Exit Function
            End If
        ElseIf (ou1 And 192) = 192 Then
            If (ou2 And 128) = 128 Then
                i = i + 2
            Else
                si_barbare = False: Exit Function
            End If
        ElseIf (ou1 And 128) = 0 Then
            i = i + 1
        Else
            si_barbare = False: Exit Function
        End If
    Loop
End Function




________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
Messages postés
2
Date d'inscription
mardi 29 mai 2012
Statut
Membre
Dernière intervention
29 mai 2012

Merci de vos commentaires.

la ligne en gras c'est le write.

Line StrConvf_in.readline,vbFromUnicode > oubli affreux de parenthèse ( mais pas dans mon code sinon ca aurait planter à ce niveau)
ce qu'il faut lire : Line = StrConv(f_in.readline,vbFromUnicode) L'objectif de ce code est de prendre dans le premier fichier texte nommé f_in,chaque ligne, ligne par ligne, en la convertissant en ANSI et de l'écrire dans le 2è fichier.

Pour la synthaxe et le code : vous avez pu mesurer que je suis une grande débutante en VB.

Merci pour vous réponses. j'en saurais plus jeudi car je ne travaille pas le mercredi.