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 99 100 101 102 103 104 105 106 107
|
Dim appExcel As Excel.Application
Dim wbExcel As Excel.Workbook
Dim Chemin As String
Dim nF, nP As Integer
Dim idFormRst, idParcRst As Integer
Dim rst As Recordset 'Recordset de la selection en cours
Dim rstForm As Recordset 'Recordset pour charger tous les champs d'une formation
Dim rstParc, rstFdeP As Recordset ' Idem pour un parcours et Recordset pour les formations d'un parcours
Set rst = Me.Recordset
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = True
Chemin = Application.CurrentProject.Path
Set wbExcel = appExcel.Workbooks.Open(Chemin & "\" & "Choix Formations.xls")
'Sauvegardele fichier modèle sous un autre nom
wbExcel.SaveAs (Chemin & "\Selection au " & Format(Date$, "dd_mm_yy") & ".xls")
'Appel de la feuille:
appExcel.Sheets("Formations").Select
appExcel.Cells(2, 2) = Date$
'parcours du recordset du choix de la sélection
If Not rst.EOF Then
rst.MoveFirst
nF = 4
nP = 4
While Not rst.EOF 'While 1
idFormRst = rst![idFormFusion]
idParcRst = rst![idParcFusion]
If idFormRst <> 0 Then 'If 1
'Création d'un rst avec toutes les données de la formation
Set rstForm = CurrentDb.OpenRecordset("SELECT * FROM T01_Formation " _
& "INNER JOIN T021_LieuForm1 ON T021_LieuForm1.idlieuform1 = T01_Formation.idlieuForm1 " _
& "WHERE T01_Formation.idFormation =" & idFormRst & ";", dbOpenDynaset)
'envoi dans l'onglet formation
appExcel.Worksheets("formations").Select
appExcel.Cells(nF, 1) = rstForm![idformation]
appExcel.Cells(nF, 2) = rstForm![titreform]
suit environ 20 lignes du meme type puis
nF = nF + 1
rstForm.Close
Else: 'Else 1
If idParcRst <> 0 Then
'Création d'un rst avec toutes les données du parcours
Set rstParc = CurrentDb.OpenRecordset("SELECT * FROM T05_Parcours " _
& "INNER JOIN T06_ListeParcMod ON T06_ListeParcMod.idparcoursliste = T05_Parcours.idparcours " _
& "WHERE T06_ListeParcMod.idparcoursliste =" & idParcRst & ";", dbOpenDynaset)
appExcel.Worksheets("Parcours").Select
'envoi dans l'onglet parcours
appExcel.Cells(nP, 1) = rstParc![idParcours]
appExcel.Cells(nP, 2) = "Parcours"
appExcel.Cells(nP, 3) = rstParc![TitreParc]
suit encore 20 lignes puis
'recherche des formations faisant partie du parcours
Set rstFdeP = CurrentDb.OpenRecordset("SELECT * FROM T06_ListeParcMod " _
& "WHERE T06_ListeParcMod.idparcoursliste =" & idParcRst & ";", dbOpenDynaset)
'Balayage des formations et envoi des données à Excel
rstFdeP.MoveFirst
While Not rstFdeP.EOF 'while 2
idFormRst = rstFdeP![idformationliste]
Set rstForm = CurrentDb.OpenRecordset("SELECT * FROM T01_Formation " _
& "INNER JOIN T021_LieuForm1 ON T021_LieuForm1.idlieuform1 = T01_Formation.idlieuForm1 " _
& "WHERE T01_Formation.idFormation =" & idFormRst & ";", dbOpenDynaset)
'envoi des données formations du parcours dans l'onglet parcours
appExcel.Cells(nP, 1) = rstFdeP![idparcoursliste]
appExcel.Cells(nP, 2) = rstForm![idformation]
appExcel.Cells(nP, 3) = rstForm![titreform]
encore 20 lignes puis
nP = nP + 1
rstForm.Close
rstFdeP.MoveNext
Wend 'wend 2
rstParc.Close
rstFdeP.Close
End If 'End if 1
End If 'End if 2
rst.MoveNext
Wend 'wend 1
rst.Close
DoCmd.Close
Else
MsgBox "Le jeu d'enregistrements est vide"
End If
'lance une macro dans Excel
appExcel.Run "miseenformelignes" |
Partager