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

Rechercher des sujets similaires à "extraire txt choisir emplacement"