Extraire en TXT et choisir emplacement Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
a
a_loic
Membre habitué
Membre habitué
Messages : 99
Inscrit le : 16 janvier 2015
Version d'Excel : 2007

Message par a_loic » 8 octobre 2015, 21:34

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
test extraction txt.xls
(144 Kio) Téléchargé 9 fois
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 7'798
Appréciations reçues : 216
Inscrit le : 16 juin 2013
Version d'Excel : 2013 UK Windows 10

Message par h2so4 » 9 octobre 2015, 11:38

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
a
a_loic
Membre habitué
Membre habitué
Messages : 99
Inscrit le : 16 janvier 2015
Version d'Excel : 2007

Message par a_loic » 9 octobre 2015, 12:02

Bonjour :)

Parfait ! Ca fonctionne parfaitement,
Merci infiniment.

Bonne journée,

Loïc
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message