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 108
| Private Sub Form_Timer()
'---------------------------------------------------------------------------------------
' Procédure : Sub ==> Form_Timer
' Auteur : <a href="http://dolphy35.developpez.com/" target="_blank">http://dolphy35.developpez.com/</a>
' Commentaires : Permet de contrôler et de proposer les mise à jour des tables
' Lien vers Faq : néant
'---------------------------------------------------------------------------------------
'
On Error GoTo Err_Form_timer
'Déclaration variable
Dim strChemin As String
'arrêt d timer
Me.TimerInterval = 0
If DLookup("VerrouAdmin", "tblAdmin") = False Then
DoCmd.Close
DoCmd.OpenForm ("Fm-zzzzz") '2ème formulaire qui doit s'ouvrir
DoCmd.Maximize
Exit Sub
Else
MsgBox "La base de Données est actuellement en mode Maintenance." & vbCrLf & _
" Veuillez essayer plus tard. Merci ", vbInformation, "Maintenance de la base"
DoCmd.Quit
End If
Err_Form_timer:
Select Case err.Number
Case 3024, 3044, 3043 'Erreur lévée si Access ne trouve pas la base Principale ou le chemin n'est pas valide
If MsgBox("La connexion à la base principale à échouée, " & vbCrLf & _
"voulez-vous redéfinir les liaisons ?", vbYesNo + vbExclamation, "") = vbYes Then
annul:
'Ouverture de la fenêtre Windows et stockage du chemin dans la variable
strChemin = OuvrirUnFichier(Me.hwnd, "Parcourir", 1, "Fichiers Access", "mdb")
'Test si présence de caractères dans la variable au cas où l'utilisateur annule
If Len(strChemin) <> 0 Then
'Appel Fonction de Liaison table avec le chemin en paramètre et test retour de la fonction
If LierTables(strChemin) = True Then
DoCmd.Close
'Code si la fonction c'est réalisée sans encombre
DoCmd.OpenForm ("Fm-zzzz") '2ème formulaire qui doit s'ouvrir
DoCmd.Maximize
Else
'Message si la fonction n'a pas renvoyer le True
MsgBox "Mise à jour des Tables non éffectuées, " & vbCrLf & _
"veuillez contacter l'administrateur de la base.", vbCritical, "Liaisons des tables"
'Fermeture de l'application
DoCmd.Quit
End If
Else
'Message si l'utilisateur à annuler la sélection du chemin
If MsgBox("Annulation par utilisateur." & vbCrLf & _
"Voulez-vous fermer l'application ?", vbYesNo + vbInformation, "Liaisons des tables") = vbYes Then
'Fermeture de l'application
DoCmd.Quit
Else
'retour début proécédure d'appel des fonctions
GoTo annul
End If
End If
Else
'Fermeture de l'application
DoCmd.Quit
End If
'Case 3043 'Erreur levée si Access n'arrive ps à se connecter au réseau
MsgBox "Il est impossible de se connecter au réseau," & vbCrLf & _
"veuillez contacter votre administrateur réseau.", vbCritical, "Erreur réseau"
Case 3049, 3428 'Base Principale corrompue
MsgBox "La base principale est endommagée," & vbCrLf & _
"veuillez contacter l'administrateur de cette base.", vbCritical, "Base Principale endommagée"
Case Else
MsgBox "Erreur N°" & err.Number & vbCrLf & err.Description
End Select
End Sub |
Partager