Discussion :

[bouh911]

Bonjour,

J'ai un soucis lors de l'importation d'un CSV avec les délimiteurs de texte.
Pièce jointe 608956

Mon fichier s'ouvre presque correctement avec la commande suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Workbooks.OpenText Filename:=Range("CheminRequete"), Origin:=65001, StartRow:=1, DataType:=xlDelimited, Semicolon:=True, Comma:=False, TextQualifier:=xlTextQualifierDoubleQuote, Local:=True

Néanmoins j'ai des retours à la ligne intempestif. Excel interprète chaque vbcrlf comme une nouvelle ligne. J'aurais besoin que Excel prenne l'ensemble des caractères entre " " comme une seule cellule. Exemple : " texte vbcrlf texte" = une seule cellule.

Via Power Query l'import fonctionne bien chez moi, malheureusement ca bug aléatoirement sur le PC de l'opérateur. C'est pour cela que je souhaiterai passer par une méthode plus "traditionnelle"

Évidement, lorsque l'on ouvre le fichier dans Excel manuellement, celui ci est correctement interprété

Un grand merci à celui qui aura la solution

[EricDgn]

Bonjour,

La reprise des données se fait immédiatement correctement avec Excel 365. Je vous en donne le code VBA. Cela vous permettra sans doute de l'adapter à votre version d'Excel.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Option Explicit
 
Sub RecupTableau()
    '--- reprend les données dans Power Query --- adresse du fichier à adapter
    ActiveWorkbook.Queries.Add Name:="TABLEAU COMPLET", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Csv.Document(File.Contents(""D:\! Tests\TABLEAU COMPLET.txt""),[Delimiter="";"", Columns=29, Encoding=65001, QuoteStyle=QuoteStyle.Csv])," & Chr(13) & "" & Chr(10) & "    #""En-têtes promus"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Type modifié"" = Table.TransformColumnTypes(#""En-têtes promus"",{{""Titre formation"", type text}, {""Code formation""," & _
        " Int64.Type}, {""Session"", Int64.Type}, {""Partie"", type text}, {""Date début partie"", type date}, {""Date fin partie"", type date}, {""Nom formateur"", type text}, {""Prénom formateur"", type text}, {""Identifiant formateur"", Int64.Type}, {""Nom Stagiaire"", type text}, {""Prénom stagiaire"", type text}, {""Identifiant stagiaire"", Int64.Type}, {""Établissement" & _
        " stagiaire"", type text}, {""Qui a choisi la formation ?"", type text}, {""Le contenu de la formation était-il en conforme au programme initial ?"", type text}, {""Cette formation a t-elle répondu à vos attentes ?"", type text}, {""Les thématiques abordées sont-elles  adaptées à votre environnement professionnel ?"", type text}, {""Le formateur maîtrisait-il son dom" & _
        "aine d'intervention ?"", Int64.Type}, {""A-t'il été à l'écoute de vos attentes pendant et après la formation ?"", Int64.Type}, {""A-t'il su favoriser les échanges au sein du groupe ?"", Int64.Type}, {""Le formateur a-t'il illustré la partie théorique avec des applications pratiques ?"", Int64.Type}, {""Les outils utilisés pendant la formation étaient-ils pertinents " & _
        "?"", Int64.Type}, {""La documentation remise vous semble t'elle contenir les points essentiels de la formation  ?"", Int64.Type}, {""Etes-vous en mesure de mettre en pratique les acquis de la formation ?"", type text}, {""Avez-vous atteint les objectifs de la formation ?"", type text}, {""La formation suivie contribue t'elle à améliorer vos compétences ?"", type tex" & _
        "t}, {""De manière générale, comment évaluez-vous la formation suivie ?"", Int64.Type}, {""Recommanderiez-vous cet organisme de formation à d'autres personnes ?"", Int64.Type}, {""Afin de nous aider à améliorer nos prestations et à vous proposer des formations de qualité, avez-vous des remarques et/ou suggestions ?"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Type modifié"""
    '--- inscrit les données de Power Query dans une nouvelle feuille
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""TABLEAU COMPLET"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [TABLEAU COMPLET]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "TABLEAU_COMPLET"
        .Refresh BackgroundQuery:=False
    End With
    '--- supprime la connexion Power Query
    ActiveWorkbook.Queries("TABLEAU COMPLET").Delete
    '--- quelques formatages
    Cells.VerticalAlignment = xlCenter
    Cells.WrapText = True
    Columns("A:M").ColumnWidth = 10
    Columns("N:N").ColumnWidth = 30
    Columns("O:AB").ColumnWidth = 24
    Columns("AC:AC").ColumnWidth = 60
    Rows("1:1").VerticalAlignment = xlCenter
End Sub

Cordialement.

[bouh911]

Merci pour le code et désolé de répondre si tardivement

En fait la première version de mon code était comme tu le proposes, avec le système de requête intégré d'Excel (Power Query). J'ai finalement abandonné ce système, car le fait d'exécuter la requête en avant plan, fait buger la procédure sur le pc de mon opérateur. Je n'ai pas encore eu l'occasion d'analyser pourquoi.
A noter qu'exécuter la requête en arrière plan fonctionne bien, mais pose problème dans la suite de mon code. Car la requête n'est parfois pas terminée que mon code continue à s'exécuter et traite par conséquent des informations non à jour (particulièrement en cas d'import de grandes quantités de données). Au moins je n'ai pas d'interruption du programme, mais la suite du code est dans l'eau. C'est pourquoi j'exécute la requête en avant plan qui permet à mon code d'attendre la fin de l'import. Mais comme précédemment dit : dès que je passe le paramètre en true, la procédure plante (uniquement sur le pc de mon utilisateur, pas sur le miens d'où la difficulté à en comprendre la raison)

Pour le moment pour solutionner le problème, je procède à l'ouverture du fichier en texte et je traite ligne à ligne chaque balise pour reformater la matrice, de l'artisanale quoi.
J'aurais souhaité une solution un peu plus propre (et plus rapide) en ouvrant directement le fichier avec le bon formatage. Comme je disais, j'ai bien spécifié avec opentext les délimiteurs de texte avec " ", mais en cas de vbcrlf à l'intérieur des " " ca pose problème... Excel ne comprend pas qu'il doit traiter l'ensemble comme un seul bloc de texte

[laurent_ott]

Bonjour.

J'ai une idée (qu'il faudrait tester car je n'arrive pas à ouvrir la pièce jointe du CSV) puisque c'est vbCrLf qui semble vous gêner.
1) lire le CSV et mémoriser le contenu dans une variable.
2) remplacer dans cette variable vbCrLf par autre chose, par exemple @@.
3) enregistrer le CSV avec cette variable modifiée (ou dans un autre fichier pour conserver l'original).
4) importer dans Excel le CSV comme vous le faites habituellement.
5) remplacer dans Excel @@ par vbCrLf.

Ci-dessous les étapes 1 à 3 :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim Texte As String
Dim FileNumber As Long
Dim FileName As String
 
FileName = "LeNomDuFichier"
 
FileNumber = FreeFile
Open FileName For Input As #FileNumber
Input #FileNumber, Texte
Close #FileNumber
 
Texte = Replace(Texte, vbCrLf, "@@")
 
FileNumber = FreeFile
Open FileName For Output As #FileNumber
Print #FileNumber, Texte
Close #FileNumber

Bonne continuation.

[Thumb down]

bonsoir,
de plus il faut noter que le fichier est en UTF8!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
Private Sub test()
Application.EnableEvents = False
PressePapier = Replace(Replace(Replace(Replace(Decode_UTF8(OuvrirFichier("C:\Myrep\TABLEAU COMPLET.txt")), vbCrLf, "®"), Chr(10), "©"), "®", vbCrLf), ";", vbTab)
Range("A1").PasteSpecial xlPasteAll
Range("A1").CurrentRegion.Replace "©", Chr(10)
Application.EnableEvents = True
End Sub
'retourne le contenu  d'un fichier texte 
Public Function OuvrirFichier(Fichier)
Set oFs = CreateObject("Scripting.FileSystemObject")
Set oFile = oFs.OpenTextFile(Fichier)
OuvrirFichier = oFile.ReadAll
oFile.Close
End Function
 
 
Public Function ClearPressePapier()
With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With
End Function
Public Property Let PressePapier(valeur)
With CreateObject("htmlfile").parentwindow.clipboardData.SetData("Text", valeur): End With
End Property
 
 
Public Property Get PressePapier()
PressePapier = CreateObject("htmlfile").parentwindow.clipboardData.GetData("TEXT")
End Property
'   Char. number range  |        UTF-8 octet sequence
'      (hexadecimal)    |              (binary)
' --------------------+---------------------------------------------
'   0000 0000-0000 007F | 0xxxxxxx
'   0000 0080-0000 07FF | 110xxxxx 10xxxxxx
'   0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
'   0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Public Function Encode_UTF8(astr)
    Dim c
    Dim n
    Dim utftext
 
    utftext = ""
    n = 1
    Do While n <= Len(astr)
        c = AscW(Mid(astr, n, 1))
        If c < 128 Then
            utftext = utftext + Chr(c)
        ElseIf ((c >= 128) And (c < 2048)) Then
            utftext = utftext + Chr(((c \ 64) Or 192))
            utftext = utftext + Chr(((c And 63) Or 128))
        ElseIf ((c >= 2048) And (c < 65536)) Then
            utftext = utftext + Chr(((c \ 4096) Or 224))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        Else ' c >= 65536
            utftext = utftext + Chr(((c \ 262144) Or 240))
            utftext = utftext + Chr(((((c \ 4096) And 63)) Or 128))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        End If
        n = n + 1
    Loop
    Encode_UTF8 = utftext
End Function
 
'   Char. number range  |        UTF-8 octet sequence
'      (hexadecimal)    |              (binary)
' --------------------+---------------------------------------------
'   0000 0000-0000 007F | 0xxxxxxx
'   0000 0080-0000 07FF | 110xxxxx 10xxxxxx
'   0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
'   0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Public Function Decode_UTF8(astr)
    Dim c0, c1, c2, c3
    Dim n
    Dim unitext
 
    If isUTF8(astr) = False Then
        Decode_UTF8 = astr
        Exit Function
    End If
 
    unitext = ""
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If
 
        If (c0 And 240) = 240 And (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 240) * 65536 + (c1 - 128) * 4096) + (c2 - 128) * 64 + (c3 - 128)
            n = n + 4
        ElseIf (c0 And 224) = 224 And (c1 And 128) = 128 And (c2 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 224) * 4096 + (c1 - 128) * 64 + (c2 - 128))
            n = n + 3
        ElseIf (c0 And 192) = 192 And (c1 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 192) * 64 + (c1 - 128))
            n = n + 2
        ElseIf (c0 And 128) = 128 Then
            unitext = unitext + ChrW(c0 And 127)
            n = n + 1
        Else ' c0 < 128
            unitext = unitext + ChrW(c0)
            n = n + 1
        End If
    Loop
 
    Decode_UTF8 = unitext
End Function
 
'   Char. number range  |        UTF-8 octet sequence
'      (hexadecimal)    |              (binary)
' --------------------+---------------------------------------------
'   0000 0000-0000 007F | 0xxxxxxx
'   0000 0080-0000 07FF | 110xxxxx 10xxxxxx
'   0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
'   0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Public Function isUTF8(astr)
    Dim c0, c1, c2, c3
    Dim n
 
    isUTF8 = True
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If
 
        If (c0 And 240) = 240 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
                n = n + 4
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 224) = 224 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 Then
                n = n + 3
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 192) = 192 Then
            If (c1 And 128) = 128 Then
                n = n + 2
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 128) = 0 Then
            n = n + 1
        Else
            isUTF8 = False
            Exit Function
        End If
    Loop
End Function

[laurent_ott]

de plus il faut noter que le fichier est en UTF8!

Bien vu.

Mais vous parlez du fichier TXT ou du CSV ?
Si c'est le cas du CSV (que je ne peux pas ouvrir mais j'ai compris que c'était la source à traiter) il faut donc effectivement transcrire le code UFT8 en String Unicode classique pour qu'Excel puisse le traiter correctement.

Ce qui donnerait :
1) lire le CSV et mémoriser le contenu dans une variable.
2) convertir cette variable au format UFT8 en format String.
3) remplacer dans cette variable vbCrLf par autre chose, par exemple @@.
4) convertir la variable au format UFT8.
5) enregistrer le CSV avec cette variable modifiée (ou dans un autre fichier pour conserver l'original).
6) importer dans Excel le CSV comme vous le faites habituellement.
7) remplacer dans Excel @@ par vbCrLf.

Pour les opérations de conversion UFT8 > String ou String > UFT8 j'utilise les API qui sont destinées à cela (Excel version 32 bits).
Je ne dis pas que c'est mieux qu'un codage VBA, c'est juste une autre approche. Chacun choisira sa solution.

API à déclarer en en-tête du module :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Const CP_UTF8 = 65001
 
Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, _
                                                                     ByVal dwFlags As Long, ByVal lpMultiByteStr As LongPtr, _
                                                                     ByVal cchMultiByte As Long, ByVal lpWideCharStr As LongPtr, _
                                                                     ByVal cchWideChar As Long) As Long
 
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, _
                                                                     ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long, _
                                                                     ByVal lpMultiByteStr As LongPtr, ByVal cbMultiByte As Long, _
                                                                     ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long

Fonctions de conversion :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
'------------------------------------------------------------------------------------------------
Public Function ConvertUTF8ToString(UTF8String As String) As String
'------------------------------------------------------------------------------------------------
Dim bData() As Byte, sData As String, lSize As Long, i As Long
 
sData = UTF8String
lSize = Len(sData)
 
If lSize > 0 Then
    ReDim bData(0 To lSize - 1)
    For i = 1 To lSize
     bData(i - 1) = Asc(Mid(sData, i, 1))
    Next i
    ' Convert all the data to Unicode
    sData = sUTF8ToUni(bData)
Else
    sData = ""
End If
 
ConvertUTF8ToString = sData
End Function
'------------------------------------------------------------------------------------------------
 
'------------------------------------------------------------------------------------------------
Public Function ConvertStringToUTF8(StrInput As String) As String
'------------------------------------------------------------------------------------------------
Dim nBytes As Long, abBuffer() As Byte, i As Long
 
If Len(StrInput) > 0 Then
    ' Get length in bytes *including* terminating null
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(StrInput), -1, 0&, 0&, 0&, 0&)
    ' We don't want the terminating null in our byte array, so ask for `nBytes-1` bytes
    ReDim abBuffer(nBytes - 2)  ' NB ReDim with one less byte than you need
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(StrInput), -1, ByVal VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&)
    ' Génèration d'une chaîne à partir du tableau:
    For i = LBound(abBuffer) To UBound(abBuffer)
        ConvertStringToUTF8 = ConvertStringToUTF8 & Chr(abBuffer(i))
    Next i
End If
 
End Function
 
'------------------------------------------------------------------------------------------------
Private Function sUTF8ToUni(bySrc() As Byte) As String
'------------------------------------------------------------------------------------------------
' Converts a UTF-8 byte array to a Unicode string
Dim lBytes As Long, lNC As Long, lRet As Long
 
lBytes = UBound(bySrc) - LBound(bySrc) + 1
lNC = lBytes
sUTF8ToUni = String$(lNC, Chr(0))
lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(bySrc(LBound(bySrc))), lBytes, StrPtr(sUTF8ToUni), lNC)
sUTF8ToUni = Left$(sUTF8ToUni, lRet)
 
End Function
'------------------------------------------------------------------------------------------------

Bonne programmation.

[fraflt69]

Bonsoir Bouh911, et vous les experts : EricDgn, Laurent_ott, Thumb down

J'ai constaté avec un éditeur visualisant les caractères de fin de lignes que le fichier texte comportait des CRLF et des LF sur les zones commentaires
Mon éditeur Notepad++ m'a permis de rechercher et remplacer les CRLF en utilisant la chaine \r\n et en cochant la case expression régulière.
Au bout de 4 remplacements, le premier a été de remplacer \r\n par @@ (merci laurent_ott), le deuxieme \n par chaine vide, le troisieme supprimer les doubles quotes, le quatrieme replacer les CRLF en remplaçant @@ par \r\n , j'ai ainsi résolu l'import du texte dans Excel sans avoir à utiliser un code.