aide sur macro xls versus txt

Essaie ceci :

'---------------------------------------
Sub SaveAsTextFile()

Dim Rg As Range, NomFichier As String
Dim Ligne As String
On Error Resume Next
With Worksheets("Feuil1")
Set Rg = Application.InputBox(Prompt:= _
"Sélectionner votre zone:" & _
"(Ex. A1:B10)", _
Title:="Sélection de zone ", _
Default:="$A$1", Type:=8)
End With
If Rg Is Nothing Then Exit Sub

NomFichier = Application.GetSaveAsFilename _
(InitialFileName:="nom_par_defaut.txt", _
fileFilter:="Text Files (*.txt), *.txt")
Dim c As Range
Open NomFichier For Output As #1
For Each r In Rg.Rows
For Each c In r.Cells
Ligne = Ligne & c.Text & ","
Next
Print #1, Ligne
Ligne = ""
Next
Close #1
End Sub
'---------------------------------------



"FLy" <admin@bocenor.com> a écrit dans le message de news:
1167944385.579789.7530@q40g2000cwq.googlegroups.com...
bonjour

en fouillant , je suis tombé sur cette macro de Charles Balch qui fait
pratiquement ce que je veux, a l'exception de 2 petites choses.

Avant de commencer, petite explication. Cette macro génere un fichier
txt avec une virgule comme séparateur de colonne.

'adapter de la macro de Charles Balch.
Sub FichierTexte() 'séparateur de colonne "," Voir***
Dim Var As Object
Set Var = Application.InputBox(Prompt:="Sélectionner votre zone:
(Ex. A1:B10) ", _
Title:="Sélection de zone ", Default:="$A$1", Type:=8)

FichierTXT = "C:ajeteressai.txt" 'à modifier


NbColonne = Var.Columns.Count
NbLigne = Var.Rows.Count
CalcState = Application.Calculation
StatusBarState = Application.DisplayStatusBar
Application.Calculation = xlManual
Calculate
Application.StatusBar = "Patientez SVP...création du fichier"


If Len(Dir(FichierTXT)) > 1 Then Kill FichierTXT
Open FichierTXT For Output As 1
'création du fichier texte
'Print #1, "Fichier texte crée à partir du tableau Excel"
'Print #1, " - Départ du tableau - "
'Print #1, ""


While Row < NbLigne
Row = Row + 1
DoEvents
Application.StatusBar = Str$(Int((Row / NbLigne) * 100)) & "%
achevé"
If (Not Var.Rows(Row).Hidden) Then
MV = ""
Col = 0
While Col < NbColonne
Col = Col + 1
If (Not Var.Columns(Col).Hidden) Then
CellV = Var.Cells(Row, Col).Text
End If


MV = MV & CellA & "," & CellV
'*** changer ici le séparateur & ","
Wend
Print #1, MV
End If
Wend


'Print #1, ""
'Print #1, " - Fin du tableau - "
'Print #1, "Nota: Fichier généré par la macro de création de
fichier texte "
'Print #1, "Nota: Le séparateur de colonne est la virgule "
Close
DoEvents
Application.Calculation = CalcState
Application.StatusBar = ""
Application.DisplayStatusBar = StatusBarState
End Sub

Ce que j'aimerais :
1- Cette macro génere une virgule au commencement et il n'y a pas de
virgule a la fin de la ligne. Comment faire le contraire ?
2- est-il possible de demander la localisation du fichier et le nom que
l'on veux lui donner

Mille Merci

Super MichDenis

Un gros MERCI . Elle fonctionne bien et elle est plus courte que
l'original. Question comme ca ? Il y a surement un moyen de ne pas
sélectionner les cellules manuellement.

Essaie ceci :

'---------------------------------------
Sub SaveAsTextFile()

Dim Rg As Range, NomFichier As String
Dim Ligne As String
On Error Resume Next
With Worksheets("Feuil1")
Set Rg = Application.InputBox(Prompt:= _
"Sélectionner votre zone:" & _
"(Ex. A1:B10)", _
Title:="Sélection de zone ", _
Default:="$A$1", Type:=8)
End With
If Rg Is Nothing Then Exit Sub

NomFichier = Application.GetSaveAsFilename _
(InitialFileName:="nom_par_defaut.txt", _
fileFilter:="Text Files (*.txt), *.txt")
Dim c As Range
Open NomFichier For Output As #1
For Each r In Rg.Rows
For Each c In r.Cells
Ligne = Ligne & c.Text & ","
Next
Print #1, Ligne
Ligne = ""
Next
Close #1
End Sub
'---------------------------------------




Mille Merci

Si tu connais d'avance la plage à exporter
dans ton fichier texte, essaie ceci :

'---------------------------------------
Sub SaveAsTextFile()

Dim Rg As Range, NomFichier As String
Dim Ligne As String
On Error Resume Next
With Worksheets("Feuil1") 'nom feuille à définir
Set Rg = .Range("A1:G25") 'plage à définir selon ton application
End With
If Rg Is Nothing Then Exit Sub

NomFichier = Application.GetSaveAsFilename _
(InitialFileName:="nom_par_defaut.txt", _
fileFilter:="Text Files (*.txt), *.txt")
Dim c As Range
Open NomFichier For Output As #1
For Each r In Rg.Rows
For Each c In r.Cells
Ligne = Ligne & c.Text & ","
Next
Print #1, Ligne
Ligne = ""
Next
Close #1
End Sub
'---------------------------------------



"FLy" <admin@bocenor.com> a écrit dans le message de news:
1168016163.058895.247580@42g2000cwt.googlegroups.com...
Super MichDenis

Un gros MERCI . Elle fonctionne bien et elle est plus courte que
l'original. Question comme ca ? Il y a surement un moyen de ne pas
sélectionner les cellules manuellement.

Essaie ceci :

'---------------------------------------
Sub SaveAsTextFile()

Dim Rg As Range, NomFichier As String
Dim Ligne As String
On Error Resume Next
With Worksheets("Feuil1")
Set Rg = Application.InputBox(Prompt:= _
"Sélectionner votre zone:" & _
"(Ex. A1:B10)", _
Title:="Sélection de zone ", _
Default:="$A$1", Type:=8)
End With
If Rg Is Nothing Then Exit Sub

NomFichier = Application.GetSaveAsFilename _
(InitialFileName:="nom_par_defaut.txt", _
fileFilter:="Text Files (*.txt), *.txt")
Dim c As Range
Open NomFichier For Output As #1
For Each r In Rg.Rows
For Each c In r.Cells
Ligne = Ligne & c.Text & ","
Next
Print #1, Ligne
Ligne = ""
Next
Close #1
End Sub
'---------------------------------------




Mille Merci