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
|
Function TraitementCSV(doc As Document, Chem As String, RapNom As String, RapFiltre As String, RapInvite As String, RapExport As String)
'Déclaration des variables
Dim rap As Report
Dim TabApp() As String
Dim i As Integer, Fp As Integer
Dim AppNom As String, AppDest As String, AppRenew As String
'ini des variable des traitments du rapport
'Set doc = ThisDocument
Set rap = doc.Reports(1)
ReDim TabApp(2, 0)
TabApp(0, 0) = ""
TabApp(1, 0) = ""
TabApp(2, 0) = ""
'ouverture du fichier CSV en lecture
Fp = FreeFile()
Open Chem + RapNom + ".csv" For Input As Fp
While Not EOF(Fp)
'Récup info de la ligne :
Input #Fp, AppNom ' Nom de l'apporteur
Input #Fp, AppDest ' Destination du rapport
Input #Fp, AppRenew ' A renouveler?
'MAJ du rapport selon l'apporteur et le type de selection :
If RapInvite <> "" Then
doc.Variables.Item(RapInvite).Value = AppNom
End If
If RapFiltre <> "" Then
rap.AddComplexFilter doc.DocumentVariables(RapFiltre), AppNom
End If
rap.ForceCompute
'Vérification/Création du répertoire de destination :
If Dir(AppDest, vbDirectory) = "" Then
MkDir (AppDest)
End If
'exportation Selon le type choisie :
If RapExport = "PDF" Then
rap.ExportAsPDF (AppDest + RapNom + " " + Replace(AppNom, "/", "-") + ".PDF")
ElseIf RapExport = "XLS" Then
rap.ExportAsExcel (AppDest + RapNom + " " + Replace(AppNom, "/", "-") + ".XLS")
Else
'A voire
End If
'enregistrement de le ligne si à renouveller
If AppRenew = "Oui" Then
If TabApp(0, 0) = "" Then '1er enregistrement dans le tableau
TabApp(0, 0) = AppNom
TabApp(1, 0) = AppDest
TabApp(2, 0) = AppRenew
Else 'si x enregistrement redimensionnement du tableau
ReDim Preserve TabApp(2, UBound(TabApp, 2) + 1)
TabApp(0, UBound(TabApp, 2)) = AppNom
TabApp(1, UBound(TabApp, 2)) = AppDest
TabApp(2, UBound(TabApp, 2)) = AppRenew
End If
End If
Wend
Close Fp
'Enregistrement du fichier CSV avec les nouvelles valeurs
Open Chem + RapNom + ".csv" For Output As Fp
For i = 0 To UBound(TabApp, 2)
Write #Fp, TabApp(0, i), TabApp(1, i), TabApp(2, i)
Next
Close Fp
End Function |
Partager