1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
Sub MaJData()
Dim Fe As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim Tbl() As String
Dim Ligne As String
Dim Dossier As String
Dim chemin As String
Dim Fichier As String
Dim i As Long
Dim j As Long
Dossier = "C:\Users\paul.fabre\OneDrive\INTERFACE\CSV\REFERENCES\" '<--- chemin à adapter !
'nom du fichier avec la date du jour
Fichier = "Ajout_Référence_ISA" & " " & Format(Now, "dd-mm-yyyy") & ".csv"
'full path
chemin = Dossier & Fichier
'si clic sur "Non", fin du programme
If MsgBox("Voulez-vous créer le fichier '" & Fichier & "' qui sera stocké dans le dossier '" & Dossier & "'?", vbQuestion + vbYesNo, "Fichier .CSV") = vbNo Then Exit Sub
'adapter le nom de la feuille à exporter
Set Fe = Worksheets("REFERENCES")
'défini la plage sur toute la feuille à exporter
Set Plage = DefPlage(Fe, 1, 1)
'crée les lignes pour les enregistrements tabulés avec comme séparateur ";"
For i = 1 To Plage.Rows.Count
For j = 1 To Plage.Columns.Count: Ligne = Ligne & Plage(i, j).Value & ";": Next j
'supprime le "," de fin
Ligne = Left(Ligne, Len(Ligne) - 1)
'stocke dans un tableau et met un ; a la place d'un emplacement vide dans le CSV ( Esthetique)
ReDim Preserve Tbl(1 To i)
Tbl(i) = Ligne
'pour la suivante
Ligne = ""
Next i
'création du fichier .csv
Open chemin For Output As #1
For i = 1 To UBound(Tbl): Print #1, Tbl(i): Next i
Close #1
'vérifie que le fichier est bien sur le disque sinon, message d'erreur
If Dir(chemin) <> "" Then
'message de confirmation
MsgBox "Le fichier '" & Fichier & "' a bien été créé et enregistré dans le dossier '" & Dossier & "' !", vbInformation
Else
MsgBox "Une erreur c'est produite durant la création du fichier .csv !", vbExclamation
End If
End Sub
Function DefPlage(Fe As Worksheet, L As Long, c As Long) As Range
On Error GoTo fin
With Fe
Set DefPlage = .Range(.Cells(L, c), _
.Cells(.Cells.Find("*", .[A1], -4123, , _
1, 2).row, .Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
End With
Exit Function
fin:
Set DefPlage = Nothing
End Function |
