Microsoft 365 problème importation fichier texte (Unicode(UTF-8)?)

Yukitos

XLDnaute Nouveau
Bonjour à tous,

Lorsque j'importe un fichier .txt je n'ai pas les accents.
le “é” est remplacé par “é”, le “ô” est remplacé par “ô”
il faut peut être incérer une commande pour Unicode (UTF-8) ?

Bonnes fêtes à tous


VB:
Sub import_donnees()
Dim fich_txt As String
Dim fich_source As String

fich_source = ActiveWorkbook.Name
'effacement des données présentes
Feuil1.Range("B2:B" & Feuil1.Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
ChDir ActiveWorkbook.Path
'demande a l'utilisateur de choisir un fichier
fich_txt = Application.GetOpenFilename("Tous les fichiers (*.txt),*.txt")
'ouverture du fichier txt
Workbooks.OpenText Filename:=fich_txt, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, Local:=True, Semicolon:=True

'copie des lignes
ActiveWorkbook.Sheets(1).Range("A1:D" & ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Copy 'Workbooks(fich_source).Feuil1.Range("A1")
'collage spéciale des valeurs
Workbooks(fich_source).Sheets(1).[B2].PasteSpecial xlValues
'fermeture du fichier
Application.DisplayAlerts = False
ActiveWorkbook.Close False
Application.DisplayAlerts = True
'End Sub
 
Solution
Re

Une version un peu plus courte
(qui fonctionne toujours sur mon PC avec le fichier exemple)
Les caractères accentués sont bien récupérés.
VB:
Sub Version_courte()
Dim fichier$
fichier = "C:\temp\regles.txt"
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=Range("A1"))
    .Name = "regles": .FieldNames = -1: .PreserveFormatting = -1
    .RefreshStyle = 1: .SaveData = -1: .AdjustColumnWidth = -1
    .TextFilePlatform = -535: .TextFileStartRow = 1: .TextFileParseType = xlDelimited
    .TextFileTextQualifier = 1: .TextFileSemicolonDelimiter = -1
    .TextFileColumnDataTypes = Array(1, 1, 1, 1): .Refresh BackgroundQuery:=False
End With
End Sub

Yukitos

XLDnaute Nouveau
Re

=>Yukitos
Poil dans la main ou lendemain de Noel difficile?
:rolleyes:
VB:
Sub Version_courte_Bis()
Dim fichier$
fichier = Application.GetOpenFilename("Tous les fichiers (*.txt),*.txt")
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=Range("A1"))
    .FieldNames = -1: .PreserveFormatting = -1
    .RefreshStyle = 1: .SaveData = -1: .AdjustColumnWidth = -1
    .TextFilePlatform = -535: .TextFileStartRow = 1: .TextFileParseType = xlDelimited
    .TextFileTextQualifier = 1: .TextFileSemicolonDelimiter = -1
    .TextFileColumnDataTypes = Array(1, 1, 1, 1): .Refresh BackgroundQuery:=False
End With
End Sub
Test toujours OK
Encore merci Jm
Peut être les deux ☺️
j'ai une erreur d'exécution mais uniquement à la première ouverture du fichier excel
Dim fichier$
fichier = Application.GetOpenFilename("Tous les fichiers (*.txt),*.txt")
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=Range("H2"))
.FieldNames = -1: .PreserveFormatting = -1
.RefreshStyle = 1: .SaveData = -1: .AdjustColumnWidth = -1
.TextFilePlatform = -535: .TextFileStartRow = 1: .TextFileParseType = xlDelimited
.TextFileTextQualifier = 1: .TextFileSemicolonDelimiter = -1
.TextFileColumnDataTypes = Array(1, 1, 1, 1): .Refresh BackgroundQuery:=False
End With
End Sub
si j'exécute une deuxième fois pas d'erreur.
 

Staple1600

XLDnaute Barbatruc
Re

Bah, mettre en commentaire ce qui pose problème.
(ou mettre sur True, pour voir ce qui se passe)
Et retester.
Le principal étant que les accents sont bien préservés, non?

PS: Le code initial a été obtenu par l'enregistreur de macros.
C'est le réflexe premier que devrait avoir tout VBAisté "débutant" ;)
 

patricktoulon

XLDnaute Barbatruc
re
re
ben pour la seconde fois c'est normal :rolleyes:

tu associe une plage a une base de donnée quel qu'elle soit (en l’occurrence ici un fichier texte) tu ne peux plus associer une nouvelle requete il te faut deleter la première
pour cela c'est simple avant le "End with" tu met ".Delete"tu garde les donnée mais la requete n'est plus
tu peux donc la relancer X fois
c'est pas plus compliqué ;)
 

Yukitos

XLDnaute Nouveau
Encore merci Jm
Peut être les deux ☺️
j'ai une erreur d'exécution mais uniquement à la première ouverture du fichier excel
Dim fichier$
fichier = Application.GetOpenFilename("Tous les fichiers (*.txt),*.txt")
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=Range("H2"))
.FieldNames = -1: .PreserveFormatting = -1
.RefreshStyle = 1: .SaveData = -1: .AdjustColumnWidth = -1
.TextFilePlatform = -535: .TextFileStartRow = 1: .TextFileParseType = xlDelimited
.TextFileTextQualifier = 1: .TextFileSemicolonDelimiter = -1
.TextFileColumnDataTypes = Array(1, 1, 1, 1): .Refresh BackgroundQuery:=False
End With
End Sub
si j'exécute une deuxième fois pas d'erreur.
Option Explicit et c'est beaucoup mieux...
Re

Bah, mettre en commentaire ce qui pose problème.
(ou mettre sur True, pour voir ce qui se passe)
Et retester.
Le principal étant que les accents sont bien préservés, non?

PS: Le code initial a été obtenu par l'enregistreur de macros.
C'est le réflexe premier que devrait avoir tout VBAisté "débutant" ;)
JM j'ai bien utilisé l'enregistreur, puis testé aussi en mettant en commentaire ou de mettre True
 

Yukitos

XLDnaute Nouveau
re
re
ben pour la seconde fois c'est normal :rolleyes:

tu associe une plage a une base de donnée quel qu'elle soit (en l’occurrence ici un fichier texte) tu ne peux plus associer une nouvelle requete il te faut deleter la première
pour cela c'est simple avant le "End with" tu met ".Delete"tu garde les donnée mais la requete n'est plus
tu peux donc la relancer X fois
c'est pas plus compliqué ;)
Bonjour Patricktoulon
cela fonctionne merci pour l'explication
 

Staple1600

XLDnaute Barbatruc
Re

Je n'ai rien fait ;)
C'est l'enregistreur qui a tout fait.
Et mon code VBA était fonctionnel depuis le message#2
(pour ce qui concerne la problématique principale: les caractères accentués)
Le reste pouvait se déduire après quelques recherches de ci de là ;)
;)
 

patricktoulon

XLDnaute Barbatruc
re
bizarre quand même j'ai testé avec le fichier donné en exemple et je n'ai pas de soucis avec les accents
voilà ce que j'ai obtenu avec l'enregistreur de ma cro
j'ai ajouté le ".delete"
VB:
Sub Macro1()
'
' Macro1 Macro
'

'   With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\polux\DeskTop\regles.txt", Destination:=Range("$A$1"))
        .CommandType = 0
        .Name = "regles"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 2, 2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        .Delete'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
End With
End Sub
 

Discussions similaires