Re : Fichier Séquentiel
bonjour Papy
code trouvé et adapté en partie,voir commentaire
Sub McExportCSV()
Dim objF As Worksheet
Dim lngCellules As Long
Dim lngColonnes As Long
Dim i As Long
Dim R As Range
Dim j As Long
Dim fCond As FormatCondition
Dim strCSV As String
Dim sPath As String
Dim Plage As Range
'Application.ScreenUpdating = False
Set objF = Excel.ActiveSheet
'*******à adapter
'sPath = "E:\Excel\Jean Pierre\Chantier\" & objF.Name & ".csv"
sPath = ThisWorkbook.Path & "\" & objF.Name & ".csv"
Set Plage = objF.Range("A2:I51") 'UsedRange
' lngColonnes = objF.UsedRange.Columns.Count
' lngCellules = objF.UsedRange.Rows.Count
'********
For i = 1 To Plage.Rows.Count 'lngCellules
For j = 1 To Plage.Columns.Count 'lngColonnes
Set R = Plage(i, j) 'objF.Cells(i, j)
If R.NumberFormat = "@" Then
strCSV = strCSV & Chr(34) & R.Value & _
Chr(34) & IIf(j < lngColonnes, ";", "")
Else
strCSV = strCSV & IIf(R.NumberFormat <> _
"General", Format(R.Value, R.NumberFormat), _
R.Value) & IIf(j < lngColonnes, ";", "")
End If
Next
strCSV = strCSV & IIf(i < lngCellules, vbCrLf, "")
Next
If Len(strCSV) > 0 Then
Open sPath For Output As 1
Print #1, strCSV
Close 1
MsgBox "L'exportation c'est bien déroulé"
Else
MsgBox "Il n'y a aucune donnée dans la feuille active"
End If
Set R = Nothing
Set fCond = Nothing
Set objF = Nothing
'Application.ScreenUpdating = True
End Sub
à bientôt
