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
| Function Automatisme()
Dim Rep1 As Integer
Dim Rep2 As Integer
On Error GoTo Macro2_Err
Rep1 = MsgBox("Voulez vous mettre la table adressage à jour?", vbYesNo, "")
If Rep1 = vbYes Then
Rep2 = MsgBox("Le Fichier Excel est il mise à jour?", vbYesNo, "")
If Rep2 = vbYes Then GoTo PointA
ElseIf Rep2 = vbNo Then
MsgBox "Merci de mettre le fichier à jour", vbOKOnly, ""
Exit Function
ElseIf Rep1 = vbNo Then GoTo PointB
End If
PointA:
DoCmd.SetWarnings False
DoCmd.OpenQuery "Sup_T_Adresssage", acViewNormal, acEdit
DoCmd.SetWarnings False
DoCmd.OpenQuery "Ajout Table BD Adressage", acViewNormal, acAdd
' Alias mois & N° de semaine commune au 3 Tables
PointB:
DoCmd.SetWarnings False
DoCmd.OpenQuery "Ajout Table BNC", acViewNormal, acAdd
DoCmd.SetWarnings False
DoCmd.OpenQuery "Ajout Table BD Manquant", acViewNormal, acAdd
DoCmd.SetWarnings False
DoCmd.OpenQuery "Ajout Table Mvt Stock", acViewNormal, acAdd
DoCmd.SetWarnings False
DoCmd.TransferSpreadsheet acExport, 0, "Demarque/Circuit", "D:\Mes Documents\00 - Réel\2012\La Buissière\Access Démarque\Demarque_Circuit.XLS", False, ""
DoCmd.Quit acSave
Macro2_Exit:
Exit Function
Macro2_Err:
MsgBox Error$
Resume Macro2_Exit
End Function |
Partager