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
| Private Sub UserSub_Click()
Me.Hide
'On Error GoTo Fin
Dim fs As Scripting.FileSystemObject
Dim gpi As DAO.Database
Dim req As DAO.Recordset
Dim sql As String
Set gpi = CurrentDb()
'Set Printer = Application.Printers("CutePDF Writer")
Mois = Split(Invite.Mois, ";")
Set fs = New Scripting.FileSystemObject
'If Not fs.FolderExists(CurrentProject.path & "\" & Invite.Mois) Then
'fs.CreateFolder (CurrentProject.path & "\" & Invite.Mois)
For i = 0 To UBound(Mois)
Dim rs As Recordset
Dim MaVille As String
Dim Monmois As String
Dim MonRec As String
Dim Condition As String
If Not fs.FolderExists(CurrentProject.path & "\" & Mois(i)) Then
fs.CreateFolder (CurrentProject.path & "\" & Mois(i))
End If
Condition = "[mois]='" & Invite.Mois & "'"
Call ConvertReportToPDF("Liste_ville", Condition, , CurrentProject.path & "\" & Mois(i) & "\Resultats_Centre.pdf", False, False, 0, "", "", 0, 0)
sql = "SELECT REC_CENTRE.Ville FROM REC_CENTRE GROUP BY Ville Order By Ville"
Set rs = gpi.OpenRecordset(sql)
While Not rs.EOF
MaVille = rs.Fields(0)
If Not fs.FolderExists(CurrentProject.path & "\" & Invite.Mois & "\" & sem(i) & "\" & MaVille) Then
fs.CreateFolder (CurrentProject.path & "\" & Mois(i) & "\" & MaVille)
End If
MaSemaine = sem(i)
Rep = CurrentProject.path & "\" & Mois(i) & "\" & MaVille
Condition = "[Ville]='" & MaVille & "' And [mois]='" & Mois(i) & "'"
Call ConvertReportToPDF("Liste_rec_centre", Condition, , Rep & "\Resultat_par_Rec.pdf", False, False, 0, "", "", 0, 0)
sql2 = "SELECT REC_CENTRE.REC FROM REC_CENTRE WHERE REC_CENTRE.Ville = '" & MaVille & "' GROUP BY REC_CENTRE.REC ORDER BY REC_CENTRE.REC "
Set rs2 = gpi.OpenRecordset(sql2)
While Not rs2.EOF
MonRec = rs2.Fields(0)
Condition = "[Rec]='" & MonRec & "' And [mois]='" & Mois(i) & "'"
Call ConvertReportToPDF("Liste_op_rec", Condition, , Rep & "\Resultats_OPs_Rec_" & MonRec & ".pdf", False, False, 0, "", "", 0, 0)
rs2.MoveNext
Wend
rs.MoveNext
Wend
Next
fin:
Set fs = Nothing
'Set Application.Printer = Nothing
End Sub |
Partager