Modifier encodage fichier txt ( UTF8 en ANSI ) en VBA
cs_Tricette
Messages postés2Date d'inscriptionmardi 29 mai 2012StatutMembreDernière intervention29 mai 2012
-
29 mai 2012 à 16:13
rdstb -
4 août 2021 à 17:03
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)
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.
MarcPL
Messages postés172Date d'inscriptionjeudi 8 décembre 2011StatutMembreDernière intervention21 juillet 20132 30 mai 2012 à 11:52
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 !
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.
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018219 29 mai 2012 à 21:12
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
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018219 29 mai 2012 à 22:19
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
cs_Tricette
Messages postés2Date d'inscriptionmardi 29 mai 2012StatutMembreDernière intervention29 mai 2012 29 mai 2012 à 22:46
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.
4 août 2021 à 17:03