Macro pour créer des .txt en UFT-8

Bonjour à tous,

Dans le cadre d'une projet pédagogique, je dois créer un petit système de questionnaires amusant pour des enfants.

Pour alimenter "Captivate (Adobe)", je voudrais utiliser Excel.

Le process est le suivant:

Les enseignants sélectionne les questions qui les intéresse et disent si ils veulent quelles soient Aléatoire (A), Obligatoire (O) ou Éliminatoire (E).

En fonction de leur choix, une autre feuille est alimentée en transformant les questions en format GIFT (language intégrable par Captivate) avec:

1. Colonne A : les questions A

2. Colonne B : les questions O

3. Colonne C : les questions E

Tout ça fonctionne très bien!

Mais c'est maintenant que je souhaite automatiser car à partir de là, je dois coller le contenu de chaque colonne dans un fichier .txt que je dois ensuite encodé en UFT-8 (rapide avec Notepad++) , et le renommer avec un préfixe qui reprend un champ (celui du nom de l'enseignant) + un autre champ (le type de question).

J'ai trouvé des petits bouts de macro grâce à vous tous (et je vous en remercie énormément) mais je suis bloqué à 2 pas du but et du coup j'ai décidé d'écrire au cas ou l'un de vous saurait m'aider.

Voici ma macro:

Sub Crée_GIFT()
    Dim Repertoire As FileDialog, prefixe As String
    Dim lig As Long, col As Long
    Dim numfich As Integer

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    prefixe = [E1] & "_COL"

    For col = 1 To 3
        numfich = FreeFile
        Open Repertoire.SelectedItems(1) & "\" & prefixe & Chr(64 + col) & ".txt" For Output As #numfich
        For lig = 1 To Cells(Rows.Count, col).End(xlUp).Row
            Print #numfich, Cells(lig, col) & vbCrLf;
        Next lig
        Close #numfich
    Next col
End Sub

La macro actuelle crée un fichier texte pour chaque colonne (ça c'est bon), mais je ne sais pas comment préfixer en lui disant (si c'est la colonne "A", mettre le préfixe Aléatoire, si c'est la B, etc..

Mais le plus gros problème, c'est l'encodage du fichier texte qui est créé, par défaut de l'ANSI. Il me faudra de l'UFT-8 car sans cela, Captivate ne peut intégrer le fichier. Comme je vais devoir générer de nombreux quiz, j'aurai aimé pouvoir bénéficier de cette macro.

J'ai trouvé quelques bribes d'informations sur certains sites anglais mais impossible de générer ce fichier texte en UFT-8.

L'un de vous saurait m'aider dans le peut de chemin qu'il me reste à parcourir?

Par avance merci à tous et même si je ne trouve pas de solution à mon problème, je tenais à remercier la communauté de ce site web qui aide beaucoup d'entre nous dans nos petits tracas Excel du quotidien (pour ceux qui travaillent avec ^^).

Bonjour,

Pour définir l'encodage, le plus simple est d'utiliser ADODB.Stream.

Voici un exemple pour enregistrer une feuille Excel au format txt UTF8 sans BOM :

Bonjour Patrice et merci pour ta réponse.

Toutefois, si je comprend bien, cela met le fichier Excel en UFT8 mais les fichiers .txt générés restent en ANSI.

Deplus, je n'arrive pas à visualiser le contenu de la macro :s

Cordialement,

JRM

Ouvres ton fichier txt avec Excel et enregistres le en UTF8

Edit : Pour l'édition macro, peut qu'avec un xls...

Edit(2) : au format txt au lieu de csv :

Malheureusement rien ne se passe.

Je te remercie en tout cas

JRM

_jrm_ a écrit :

Malheureusement rien ne se passe.

C'est-à-dire ?

Tu n'as toujours pas accès au code ?

Oui. Comme s'il n'y avait rien.

As tu réussi à activer la macro de la feuille GIFT de mon fichier?

J'ai vu passer des articles sur ce dont tu parlais (ADODB.Stream) dont ce code, sans savoir comment l'utiliser.

Private Sub CreateFile(ByVal pstrFile As String, ByVal pstrData As String)
    Dim objStream As Object
    'Create the stream
    Set objStream = CreateObject("ADODB.Stream")

    'Initialize the stream
    objStream.Open

    'Reset the position and indicate the charactor encoding
    objStream.Position = 0
    objStream.Charset = "UTF-8"

    'Write to the steam
    objStream.WriteText pstrData

    'Save the stream to a file
    objStream.SaveToFile pstrFile
End Sub

J'ai réussi à ouvrir la macro sur un autre PC

Dim nom$
  nom = ThisWorkbook.Path & "\" & Me.Name & ".txt"
  Call mExport.Enregistrer_UTF8_sans_BOM_txt(Me, nom)

J'ai testé, cependant je ne comprend pas comment celle-ci fonctionne.

A quoi réfère Me.Name ?

Je n'ai pas réussi à associer ma première macro à celle ci.

Pourriez vous m'aider à finaliser?

JRM

Re,

Me c'est l'objet qui contient le code, dans ce cas la feuille 1.

et Me.Name c'est son nom (celui de l'onglet)

Bonsoir Patrice,

J'ai essayé de trituré ton code dans tous les sens (enfin surtout d'y mettre le miens) mais je dois être trop nul je n'arrive )as à ce que je veux.

C'est dommage parce que ton fichier génère bien un .txt en UTF8 comme il me faut, hormis qu'il copie le contenu de la feuille au lieu de la colonne.

J'ai essayé de changer des variables pour qu'il ne me copie que la première colonne mais ça n'a pas marché.

J'ai essayé d'y mettre un peu de mon code pour que cela me fasse 3 fichiers (1 par colonne) mais ça n'a pas marché non plus.

Merci qu'en même pour ton aide

Du coup avec ma femme on va voir combien ça coûte pour que quelqu'un nous aide. On voudrait que ça tourne avant la rentrée scolaire.

Cordialement,

JRM

Bonjour,

Voila le code adapté a ton fichier pour créer des fichiers txt UTF8 sans BOM :

EDIT : code corrigé

Option Explicit
Option Private Module
Sub Crée_GIFT()
Dim fUtf8avecBOM As ADODB.Stream  'flux de données Utf8 avec BOM
Dim fUtf8sansBOM As ADODB.Stream  'flux de données Utf8 sans BOM
Dim Repertoire As FileDialog      'boite de dialogue choix dossier
Dim prefixe As String             'chemin et prefixe du nom du fichier
Dim nomfich As String             'nom complet du fichier (avec chemin)
Dim lig As Long, col As Long      'ligne, colonne
    ' Définir l'emplacement des fichiers
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    prefixe = Repertoire.SelectedItems(1) & "\" & Worksheets("GIFT").Range("E1") & "_COL"
    ' Créer les fichiers txt
    For col = 1 To 3
        ' Définir le flux de données Utf8 avec BOM
        Set fUtf8avecBOM = New Stream
        fUtf8avecBOM.Charset = "utf-8"
        fUtf8avecBOM.Mode = adModeReadWrite
        fUtf8avecBOM.Type = adTypeText
        fUtf8avecBOM.Open
        ' Ajouter les données au flux de données Utf8 avec BOM
        With Worksheets("GIFT")
          For lig = 1 To .Cells(.Rows.Count, col).End(xlUp).Row
            fUtf8avecBOM.WriteText .Cells(lig, col).Text
            fUtf8avecBOM.WriteText vbCrLf
          Next lig
        End With
        ' Pointer après le BOM
        fUtf8avecBOM.Position = 3
        ' Définir le flux de données Utf8 sans BOM
        Set fUtf8sansBOM = New Stream
        fUtf8sansBOM.Mode = adModeReadWrite
        fUtf8sansBOM.Type = adTypeBinary
        fUtf8sansBOM.Open
        'Ajouter les données (sans le BOM)
        fUtf8avecBOM.CopyTo fUtf8sansBOM
        fUtf8avecBOM.Flush
        fUtf8avecBOM.Close
        Set fUtf8avecBOM = Nothing
        ' Enregistrer le fichier
        nomfich = prefixe & Chr(64 + col) & ".txt"
        fUtf8sansBOM.SaveToFile nomfich, adSaveCreateOverWrite
        fUtf8sansBOM.Close
        Set fUtf8sansBOM = Nothing
    Next col
End Sub

Si le format UTF8 avec BOM suffit, je peux simplifier le code

J'ai été confronté au problème aussi... ET sous excel il n'existe aucun moyen de creer du texte en UTF8 sans BOM.

Les bout de codes qui trainent sur le net ne fonctionnen pas !

J'avais bricolé une macro pour piloter Notepad++ avec la fonction sendkey (en cherchant sur le forum tu trouvera un de mes posts sur le sujet).

Par contre si tu veux faire de l'UTF8 avec BOM y a moyen de moyenner en passant par word !

J'ai corrigé le code