Discussion :

[Vanessa Utzinger]

Bonjour

Je souhaite créer une macro pour pouvoir ouvrir ce fichier en fichier xlsx

Pouvez-vous m'aider ?

Merci
Salutations
Vanessa Utzinger

[kiki29]

Salut, essaie déjà via l'enregistreur de macros, sauve en xlsm ou xlsb

[Vanessa Utzinger]

Merci mais en fait cela me donne une mise en page qui ne me convient pas et je ne sais pas comment dire à ma macro d'écrire en respectant le format de cette pièce jointe.

[kiki29]

Salut, que veux-tu faire de ce fichier ?

Affecter un bouton à la procédure SelFichier

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
Option Explicit
 
Dim sCheminDossier As String
Const sNomDossier As String = "Dossier XLSX"
 
Private Sub CreationDossier()
Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    sCheminDossier = ThisWorkbook.Path & "\" & sNomDossier
    If Not FSO.FolderExists(sCheminDossier) Then FSO.CreateFolder (sCheminDossier)
    Set FSO = Nothing
End Sub
 
Private Sub Lecture(sNomFichier As String)
Dim FSO As Object, sOut As String
Dim sNom As String, sExt As String
Dim sNouveauNom As String
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    sNom = FSO.GetFileName(sNomFichier)
    sExt = FSO.GetExtensionName(sNomFichier)
    sOut = Left$(sNom, Len(sNom) - Len(sExt) - 1)
    Set FSO = Nothing
 
    Workbooks.OpenText Filename:= _
            sNomFichier, _
            Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
            xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
            Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
            TrailingMinusNumbers:=True
 
    Cells.Select
    With Selection.Font
        .Name = "Courier New"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A1").Select
 
    sNouveauNom = RenommerFichier(sCheminDossier, sOut, "xlsx")
    ActiveWorkbook.SaveAs Filename:=sNouveauNom, FileFormat:=xlOpenXMLWorkbook
    ActiveWindow.Close
End Sub
 
Private Function RenommerFichier(sDossier As String, sNomFichier As String, sExtension As String) As String
Dim sNouveauNom As String
Dim i As Long
Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.fileExists(sDossier & "\" & sNomFichier & "." & sExtension) = True Then
        sNouveauNom = sNomFichier
        i = 0
        While FSO.fileExists(sDossier & "\" & sNouveauNom & "." & sExtension) = True
            i = i + 1
            sNouveauNom = sNomFichier & Chr(40) & Format(i, "000") & Chr(41)
        Wend
        sNomFichier = sNouveauNom
    End If
    Set FSO = Nothing
    RenommerFichier = sDossier & "\" & sNomFichier & "." & sExtension
End Function
 
Sub SelFichier()
Dim Fichier As Variant
    ChDir ThisWorkbook.Path
    Fichier = Application.GetOpenFilename("Fichiers Texte (*.txt), *.txt", Title:="Sélection Fichier")
    If Fichier = False Then Exit Sub
    DoEvents
    Application.ScreenUpdating = False
    CreationDossier
    Lecture (Fichier)
    Application.ScreenUpdating = True
End Sub

[Vanessa Utzinger]

Merci kiki29 mais je pense que je n'ai pas assez de connaissances pour comprendre ta dernière réponse :-(

[kiki29]

Salut, tu copies l'ensemble du code dans un module standard, puis tu affectes un bouton "Formulaire" ou "ActiveX" à la macro SelFichier.
En cliquant sur ce bouton une boite de dialogue t'invitera à sélectionner un fichier *.txt, cette sélection faite la transformation est effectuée et un dossier "Dossier XLSX" est créé, le classeur de la transformation y est sauvé ( en tenant compte des éventuels doublons via un indice (001)(002) etc ).