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
| '--- Interrogation de la tbl adhérents rs1
rq = "select * From [tbl Adhérents]"
Set rs1 = Db.OpenRecordset(rq, dbOpenDynaset)
IntEnrg = 1
rs.MoveLast
IntTotalEnrg = rs.RecordCount
rs.MoveFirst
'--- Ouverture de l'application
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlw = xlApp.ActiveWorkbook
'--- Boucle sur la table Adhérents rs1
Do Until rs1.EOF
'--- Mettre à jour la barre de progression
SysCmd acSysCmdUpdateMeter, IntEnrg
Forms![frm Mise à jour]!Jauge.Object.max = IntTotalEnrg
Forms![frm Mise à jour]!Jauge.Object.Value = IntEnrg
rs1.MoveNext
IntEnrg = IntEnrg + 1
Loop
'--- Affiche le formulaire Message1
Beep
stDocName = "frm Message1"
'--- Ouvrir chaque document sélectionné et le traiter
For Each varFichier In fd.SelectedItems
xlApp.Workbooks.Open (varFichier)
'--- Supprimer les enregistrements de la tbl Adhérents
Db.Execute "Delete from [tbl Adhérents]"
'--- Passer à la partie Importation Feuille
DoCmd.TransferSpreadsheet acImport, _
acSpreadsheetTypeExcel9, "tbl Adhérents ", varFichier, True, strFeuille & "!A1:AD20000"
Next
'--- Affiche le formulaire Message2
Beep
DoCmd.OpenForm "frm Message2"
'--- Effacer la barre de progression
Forms![frm Mise à jour]!Jauge.Object.Value = 0
SysCmd (acSysCmdClearStatus) |
Partager