Sub ExportCSV()
Dim LigneCSV As String, Chemin$, Fichier$, CheminFichier$, NoFich%
Dim PlageCSV As Range
Dim Ligne As Integer, Colonne As Integer, Nb_Ligne As Integer, Nb_Colonne As Integer
'------- saisie du chemin ------------------
Fichier$ = "testexcel.csv" '< nom du fichier
Chemin$ = FLoadNomDuREP '< saisie du chemin
If Chemin$ = "" Then Exit Sub
If Right(Chemin$, 1) <> "\" Then Chemin$ = Chemin$ & "\"
CheminFichier$ = Chemin$ & Fichier$
If MsgBox(CheminFichier$ & vbLf & vbLf & "Veuillez confirmer ?", vbQuestion + vbYesNo, "") <> vbYes Then Exit Sub
'-----------------------
'Fermeture ficher si ouvert
Close
'Plage CSV
Set PlageCSV = Worksheets("Donné équipement").Range("A1:T650")
'Ouverture du fichier de sortie
NoFich = FreeFile 'no de fichier inutilsé !
Open CheminFichier$ For Output As #NoFich
'Butees de comptage
Nb_Ligne = PlageCSV.Rows.Count
Nb_Colonne = PlageCSV.Columns.Count
'Boucle sur la plage et ajoute les lignes au fichier
For Ligne = 1 To Nb_Ligne
For Colonne = 1 To Nb_Colonne
If LigneCSV <> "" Then
LigneCSV = LigneCSV & ";"
End If
'construction ligne
LigneCSV = LigneCSV & PlageCSV.Cells(Ligne, Colonne).Value
Next Colonne
'Enregistrement ligne
Print #NoFich, LigneCSV
LigneCSV = ""
Next Ligne
'Fermeture du fichier
Close #NoFich
End Sub
'select la petite boite ouvrir dossier (sans fonction ni référence spéciale)
'param en bout , &H1& )avec le bouton "créer un nouveau dossier"
'------------- , &H201&)sans le bouton "...
Function FLoadNomDuREP() As String 'saisie un chemin
M$ = "Sélectionnez un dossier"
Dim ObjFolder As Object, Chemin As String
Set ObjFolder = CreateObject("Shell.Application").BrowseForFolder(&H0&, M$, &H201&, "")
If Not ObjFolder Is Nothing Then
Chemin = ObjFolder.Items.Item.Path
On Error Resume Next: Err.Clear 'test si le Rep est valide ?
Set ObjFolder = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
If Err Then MsgBox "Répertoire non valide !?": Chemin = ""
On Error GoTo 0: Err.Clear
Else: Chemin = ""
End If
FLoadNomDuREP = Chemin
Set ObjFolder = Nothing
End Function