Extraire en TXT et choisir emplacement
Bonjour,
J'ai un tableau depuis quelques temps qui fonctionnait parfaitement.
Cependant, depuis peu, le disque sur lequel s'enregistre le document que la macro crée est inutilisable.
La macro tourne alors au fiasco, debugage et tout le touintouin.
Malheureusement, je n'arrive pas à changer pour améliorer le document.
Le top, ce serai que l'on puisse choisir l'emplacement via une fenêtre de dialogue, mais je n'ai jamais réussi à faire cela...
Pourtant j'ai bien le code, mais je n'arrive pas à le placer sans avoir le message d'erreur de compilation, je me sens nul
On Error GoTo 1
Dim finput As FileDialog
Set finput = Application.FileDialog(msoFileDialogFolderPicker)
finput.Show
With finput
Sheets(1).Cells(1, 1) = .SelectedItems(1)
End With
1:
Je colle ci dessous le code de la macro actuelle (je mets également le fichier en PJ)
Merci d'avance à tous,
Bonne journée,
Loïc
Option Explicit
Public Function XportTxt(Sh As Worksheet) As Boolean
Dim FSO As Scripting.FileSystemObject
Dim Ts As TextStream
Dim i%, LeNom$
LeNom = "L:\" & Format(Date, "ddmmyyyy") & "_CasExceptionnels" & ".txt" ' à ajuster
Set FSO = New Scripting.FileSystemObject
Set Ts = FSO.CreateTextFile(LeNom)
For i = 5 To Sh.Range("E" & Rows.Count).End(xlUp).Row 'De 5 à la dernière ligne non vide de la colonne E
If Len(Sh.Range("G" & i)) = 0 Then Ts.WriteLine (Sh.Range("E" & i) & ";" & Format(Sh.Range("F" & i) & Sh.Range("H" & i), "0.00"))
Next i 'Si rien en colonne G, on écrit sur une nouvelle ligne d'un txt la valeur en colonne E; valeur en F et H
If FSO.FileExists(LeNom) Then MsgBox "Fichier créé.", vbInformation, "Confirmation"
Set FSO = Nothing: Set Ts = Nothing 'On libère la mémoire
XportTxt = True 'Pour éviter que le texte de la celulle A1 soit selectionnée.
End Function
Bonjour,
essaie ceci
Option Explicit
Public Function XportTxt(Sh As Worksheet) As Boolean
Dim FSO As Scripting.FileSystemObject
Dim Ts As TextStream
Dim i%, LeNom$
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
LeNom = .SelectedItems(1) & "\" & Format(Date, "ddmmyyyy") & "_CasExceptionnels" & ".txt" ' à ajuster
End With
Set FSO = New Scripting.FileSystemObject
Set Ts = FSO.CreateTextFile(LeNom)
For i = 5 To Sh.Range("E" & Rows.Count).End(xlUp).Row 'De 5 à la dernière ligne non vide de la colonne E
If Len(Sh.Range("G" & i)) = 0 Then Ts.WriteLine (Sh.Range("E" & i) & ";" & Format(Sh.Range("F" & i) & Sh.Range("H" & i), "0.00"))
Next i 'Si rien en colonne G, on écrit sur une nouvelle ligne d'un txt la valeur en colonne E; valeur en F et H
If FSO.FileExists(LeNom) Then MsgBox "Fichier " & lenom & " créé.", vbInformation, "Confirmation"
Set FSO = Nothing: Set Ts = Nothing 'On libère la mémoire
XportTxt = True 'Pour éviter que le texte de la celulle A1 soit selectionnée.
End Function
Bonjour
Parfait ! Ca fonctionne parfaitement,
Merci infiniment.
Bonne journée,
Loïc