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

Staple1600

XLDnaute Barbatruc
Bonjour le fil

En important le fichier texte, par ce biais
(Données/Importer)
On peut paramétrer la source
(voir exemple ci-dessous)
VB:
Sub test()
With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Temp\test.txt", Destination:=Range("A1"))
        .Name = "test"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .TextFilePlatform = -535 'UTF8
        .Refresh BackgroundQuery:=False
    End With
End Sub
NB: Je n'ai pas mis toutes les lignes de code généré par l'enregistreur de macros pour gain de place.
 

Staple1600

XLDnaute Barbatruc
Re, bonjour patricktoulon

=>Yukitos
C'est ce que fait mon bout de code, non?
Obtenu par l'enregisteur de macros
Fais l'essai et tu verras

NB: C'est que j'avais en commentaires (en vert ) dans le code.
Mais avais-tu lu le commentaire ;) ?

EDITION: Désolé pour la collision, patricktoulon ;)
 

Staple1600

XLDnaute Barbatruc
Re

Test OK chez moi avec ton fichier txt
NB:Adapter le chemin du dossier où se trouve le fichier txt avant de lancer ma macro.
VB:
Sub Test_OK()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\temp\regles.txt", _
        Destination:=Range("A1"))
        .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 = -535
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
 

Staple1600

XLDnaute Barbatruc
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

Test OK chez moi avec ton fichier txt
NB:Adapter le chemin du dossier où se trouve le fichier txt avant de lancer ma macro.
VB:
Sub Test_OK()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\temp\regles.txt", _
        Destination:=Range("A1"))
        .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 = -535
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
Merci JM
Mais le chemin et le nom du fichier peuvent être différents.
 

Staple1600

XLDnaute Barbatruc
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
 

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 786
Membres
101 817
dernier inscrit
carvajal