Choix du disque d'envoi

a_loic · 2 Octobre 2015

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.
Je souhaitais faire en sorte que le document créé par la macro s'enregistre sous le chemin d'accès saisi en cellule A2 par exemple.

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...

Je colle ci dessous le code de la macro (je mets également le fichier en PJ)

Merci d'avance à tous,

Bonne journée,

Loïc

Code:

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

don_pets · 2 Octobre 2015

Re : Choix du disque d'envoi

'llo

voici un début d'aide, pour afficher un chemin via nue boîte de dialogue

Code:

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:

Bon courage pour la suite

don

a_loic · 2 Octobre 2015

Re : Choix du disque d'envoi

Re

Merci pour la réponse !

J'ai tenté quelques trucs mais je n'y comprends rien...
Je me retrouve toujours avec des erreurs de compilation

Peux tu m'aider à nouveau?

Merci encore,

Bonne journée,

Loïc

don_pets · 2 Octobre 2015

Re : Choix du disque d'envoi

bin je ne pige pas, elle fonctionne très bien ta macro, il te faut simplement à mon avis modifier la lettre L présente dans ton code par le lecteur dans lequel tu veux créer ton fichier txt

a_loic · 2 Octobre 2015

Re : Choix du disque d'envoi

Oui la macro est opérationnelle.

Le disque L: n'existe plus, il faut donc le remplacer.

Seul problème, le bug risque de se reproduire à l'avenir, en cas de suppression du nouveau disque etc...

Je voulais donc prévoir le futur en ajoutant une fenetre de selection d'emplacement

Encore merci,

Bonne journée,

Loïc

don_pets · 2 Octobre 2015

Re : Choix du disque d'envoi

ok donc avec ça :

Code:

On Error GoTo 1
Dim finput As FileDialog
Set finput = Application.FileDialog(msoFileDialogFolderPicker)
finput.Show

tu fais apparaître la fenêtre pour spécifier un chemin

et avec ça

Code:

With finput
Sheets(1).Cells(1, 1) = .SelectedItems(1)
End With
1:

tu affiches ce chemin dans une cellule (a1 du premire onglet dans cet exemple).

Tu devrais pouvoir l’adapter à ton code

a_loic · 2 Octobre 2015

Re : Choix du disque d'envoi

Re

Je dois être idiot...
Je n'y arrive vraiment pas

Toujours des problèmes de compilation... Je ne sais pas où placer ce code :'(

Désolé, ca doit être chiant !

Bonne journée,

Loïc

don_pets · 2 Octobre 2015

Re : Choix du disque d'envoi

No prob, mais là c'est un peu tendu pour te le faire de suite, si ça n'urge pas te le fais en début de semaine

as you want

a_loic · 8 Octobre 2015

Re : Choix du disque d'envoi

Bonjour

As tu une possibilité et du temps pour moi?

Je te remercie pour l'aide que tu me proposes.

Très bonne journée,

Loïc

don_pets · 9 Octobre 2015

Re : Choix du disque d'envoi

Yes j'ai du temps tday, j'ai rendu mes autres copies en avance.

Je me remets sur ton sujet, te tiens au jus

don_pets · 9 Octobre 2015

Re : Choix du disque d'envoi

Remplace ton code par celui-ci :

Code:

Public Function XportTxt(Sh As Worksheet) As Boolean

Dim FSO As Scripting.FileSystemObject
Dim Ts As TextStream
Dim i%, LeNom$
Dim finput As FileDialog

On Error GoTo 1

Set finput = Application.FileDialog(msoFileDialogFolderPicker)
finput.Show

With finput

  LeNom = .SelectedItems(1) & 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.
 
1:
End With
End Function

and tell me

don

a_loic · 9 Octobre 2015

Re : Choix du disque d'envoi

Bonjour

La fenêtre s'ouvre et la macro ne plante pas, mais aucun fichier n'est créé :s

Merci à toi pour ton aide,

Bonne journée,

Loïc

don_pets · 9 Octobre 2015

Re : Choix du disque d'envoi

boaa bizarre moi il me crée un txt avec les lignes dedans, je t'envoie le mien afin de vérifier que cela fasse bien la même chose !

Choix du disque d'envoi

a_loic

XLDnaute Junior

Pièces jointes

don_pets

XLDnaute Occasionnel

a_loic

XLDnaute Junior

don_pets

XLDnaute Occasionnel

a_loic

XLDnaute Junior

don_pets

XLDnaute Occasionnel

a_loic

XLDnaute Junior

don_pets

XLDnaute Occasionnel

a_loic

XLDnaute Junior

don_pets

XLDnaute Occasionnel

don_pets

XLDnaute Occasionnel

a_loic

XLDnaute Junior

don_pets

XLDnaute Occasionnel

Pièces jointes

Discussions similaires