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
|
Dim ws As Workspace
' On déclare l'objet permettant de modifier notre requête
Dim acApp As Database
' On déclare l'objet permettant l'impression de nos fichiers
Dim MesEtats As Access.Application
Lbl_Infos.Caption = "L'exportation est en cours, veuillez patienter..."
If CheminUser = "" Then
CheminUser = bGetRegValue(HKEY_CURRENT_USER, "Software\FD", "CheminFichier")
End If
For i = 1 To FlexGrid_Res.Rows - 1
Set ws = DBEngine.CreateWorkspace("JetTest", "Admin", "")
DBEngine.Workspaces.Append ws
Set acApp = ws.OpenDatabase(BaseMaitre)
FlexGrid_Res.row = i
Filtres = ""
NomFichier = Format(Date, "yyyymmdd")
With acApp
With .QueryDefs("R_DetailsListe")
FlexGrid_Res.Col = 0
NomFichier = NomFichier & "-" & Trim(FlexGrid_Res)
Filtres = "Chp1= '" & FlexGrid_Res & "' "
'.SQL = Replace(.SQL, "[monChp1]", "'" & FlexGrid_Res & "'")
FlexGrid_Res.Col = 1
NomFichier = NomFichier & "-" & Trim(FlexGrid_Res)
Filtres = Filtres & "AND Chp2 = '" & FlexGrid_Res & "'"
'.SQL = Replace(.SQL, "[monChp2]", "'" & FlexGrid_Res & "'")
.SQL = "SELECT TOP 1 [RS] & ' ' & Trim([V]) & ' - ' & [E] AS RaS, 'Situtation ' & Left([Semaine],4) & ' à fin semaine ' & Right([Semaine],2) AS Annee, T_RMI.Periode, T_RMI.V, T_RMI.E, 'Édité le ' & Date() AS DateduJour, T_CT.S " & _
"From T_RMI, T_CT " & _
"GROUP BY [RS] & ' ' & Trim([V]) & ' - ' & [E], 'Situtation ' & Left([Semaine],4) & ' à fin semaine ' & Right([Semaine],2), T_RMI.Periode, T_RMI.V, T_RMI.E, T_CT.S, T_RMI.Semaine " & _
"Having (((T_RMI.Periode) = 'h') AND " & Filtres & ") " & _
"Order By 'Situtation ' & Left([Semaine],4) & ' à fin semaine ' & Right([Semaine],2) DESC , T_RMI.Semaine DESC;"
.Close
End With
End With
acApp.Close
Set acApp = Nothing
PauseAppli 3
Connection_base BaseMaitre, con
compteur = 1
While Not EnAttente
compteur = compteur + 1
Set rs = lecture_enregistrement("SELECT V, E FROM R_DetailsListe WHERE " & Filtres, con)
If Not rs.EOF Then
EnAttente = True
End If
Wend
Debug.Print "Nombre de tentatives : " & compteur & " pour " & Filtres
fermeture_recordset rs
fermeture_connection_base con
DBEngine.BeginTrans
DBEngine.CommitTrans dbForceOSFlush
DBEngine.Idle dbRefreshCache
Set MesEtats = New Access.Application
MesEtats.OpenCurrentDatabase BaseMaitre, False
EnAttente = False
Set ImprimanteParDefaut = MesEtats.Printer
Set MesEtats.Printer = MesEtats.Printers("Acrobat PDFWriter")
bSetRegValue HKEY_CURRENT_USER, "Software\Adobe\Acrobat PDFWriter", "PDFFileName", IIf(CheminUser <> "", IIf(Right(CheminUser, 1) <> "\", CheminUser & "\", CheminUser), CheminDefaut) & NomFichier & ".pdf"
MesEtats.DoCmd.OpenReport "Top20_1", acViewNormal
MesEtats.DoCmd.Close acReport, "Top20_1", acSaveNo
Set MesEtats.Printer = ImprimanteParDefaut
MesEtats.CloseCurrentDatabase
MesEtats.Quit acQuitSaveNone
Set MesEtats = Nothing
Next i |