boite de dialogue pour diriger l'export

[olivierd]

bonjour lecteurs du matin,

sous Windows, comment obtenir la boite de dialogue
permettant de selectionner l'endroit ( la destination:bureau, dossier...)
ou exporter le fichier texte
de la macro ci-dessous ?'mon_fichierdexport.txt'

Sub export_txt_6_colonnes()
Open 'mon_fichierdexport.txt' For Output As 1
Dim i As Integer, derniereligne As Integer
Sheets('mafeuille_mononglet').Select
derniereligne = [a65536].End(xlUp).Row
For i = 1 To derniereligne
For j = 1 To 6
MaCellule = Cells(i, j).Value
If IsEmpty(MaCellule) = True Then MaCellule = vbNullChar
Maligne = Maligne & MaCellule & vbTab
Next j
Maligne = Left(Maligne, Len(Maligne) - 1) 
Print #1, Maligne
Maligne = ''
Next i
Close
End Sub

Amicalement
merci pour vos conseils

 

[MichelXld]

bonjour Olivier

tu peux tester cette méthode pour choisir un répertoire

Sub choisirRepertoire()
Dim objShell As Object, objFolder As Object
Dim SecuriteSlash As Integer
Dim Fichier As String, Chemin As String

Set objShell = CreateObject('Shell.Application')
Set objFolder = objShell.BrowseForFolder(&H0&, 'Choisir un répertoire', &H1&)

On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path
If objFolder.Title = '' Then Chemin = ''
SecuriteSlash = InStr(objFolder.Title, ':')
If SecuriteSlash > 0 Then Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ''

If Chemin <> '' Then MsgBox Chemin
End Sub

bon week end
MichelXld

 

[olivierd]

bonjour,
merci MichelXldn cela fonctionne parfaitement
mais comment intégrer cette fonction à ma macro ? 😱

 

[MichelXld]

rebonjour Olivier

j'espere que cette adaptation répondra à ta demande

Sub export_txt_6_colonnes()
Dim objShell As Object, objFolder As Object
Dim SecuriteSlash As Integer
Dim Fichier As String, Chemin As String, MaLigne As String
Dim j As Byte
Dim i As Integer, DerniereLigne As Integer
Dim MaCellule As Variant

'******************
'fs
Set objShell = CreateObject('Shell.Application')
Set objFolder = objShell.BrowseForFolder(&H0&, 'Choisir un répertoire', &H1&)

On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path
If objFolder.Title = '' Then Chemin = ''
SecuriteSlash = InStr(objFolder.Title, ':')
If SecuriteSlash > 0 Then Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ''
'*****************

If Chemin = '' Then
MsgBox 'Operation annulée . '
Exit Sub
End If

DerniereLigne = Sheets('mafeuille_mononglet').Range('A65536').End(xlUp).Row

Open Chemin & '\\mon_fichierdexport.txt' For Output As 1

For i = 1 To DerniereLigne
        For j = 1 To 6
        MaCellule = Cells(i, j).Value
        If IsEmpty(MaCellule) = True Then MaCellule = vbNullChar
        MaLigne = MaLigne & MaCellule & vbTab
        Next j
MaLigne = Left(MaLigne, Len(MaLigne) - 1)
Print #1, MaLigne
MaLigne = ''
Next i

Close 1
End Sub

bon apres midi
MichelXld

 

[olivierd]

Yep! merci beaucoup
cela marche parfaitement sous Windows

par contre, il n'est pas possible de selectionner le Bureau comme destination...

Bon ouik
A+

Message édité par: olivierd, à: 26/03/2005 12:39

Message édité par: olivierd, à: 26/03/2005 12:40