Bonjour,
Je me suis servi de cette discussion car je me trouvais dans le même cas de figure que MsnSylvain.
Cela fonctionne parfaitement jusqu'au moment ou j'ai ajouté de nouvelles tables liées mais provenant d'un .mdb différent de celui renfermant les tables utilisées jusqu'à maintenant.
J'ai essayé de m'en sortir par plusieurs manip mais en vain. Voici l'état actuel de mon code :
Formulaire de démarrage (sur ouverture) :
et modules de code :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Private Sub Form_Open(Cancel As Integer) Dim strTLPrometheeReseau As String Dim strTLPrometheeLocal As String Dim strTLDaedalusReseau As String Dim strTLDaedalusLocal As String Dim intChoix As Integer retour: strTLPrometheeReseau = "" strTLPrometheeLocal = "" strTLDaedalusReseau = "" strTLDaedalusLocal = "" On Error Resume Next strTLPrometheeReseau = Dir("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Réseau\testcode.mdb") strTLPrometheeLocal = Dir("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Local\testcode.mdb") strTLDaedalusReseau = Dir("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Réseau\BdMultiCritere.mdb") strTLDaedalusLocal = Dir("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Local\BdMultiCritere.mdb") On Error GoTo 0 If strTLPrometheeReseau <> "" Then TLPrometheeReseau TLDaedalusReseau Else intChoix = MsgBox("La base réseau ne peut être jointe. Vérifier votre connexion réseau. Cliquez sur Oui pour réessayer, sur non pour vous connecter à une base locales (pour maintenance seulement) ou sur annuler pour abandonner", vbYesNoCancel, "Avertissement connexion:") If intChoix = vbYes Then GoTo retour ElseIf intChoix = vbCancel Then DoCmd.Close Else If strTLPrometheeLocal <> "" Then TLPrometheeLocal TLDaedalusLocal Else MsgBox "Aucune Base disponible, réessayer lorsque le réseau sera connecté" End If End If End If End Sub
mais je manque de connaissance en VBA (grammaire ET dictionnaire).
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Option Compare Database Function fRediriger_donnees(arg_chemin As String) As Boolean Dim Var As Variant Dim I As Integer Dim Tdf As TableDef Dim Db As Database On Error GoTo fRediriger_donnees_Exit fRediriger_donnees = False Set Db = CurrentDb Var = SysCmd(SYSCMD_INITMETER, "Patientez !!! Réorganisation en cours des données...", Db.TableDefs.Count) For I = 0 To Db.TableDefs.Count - 1 Set Tdf = Db.TableDefs(I) If Tdf.Connect & "" <> "" Then 'la table est attachée Tdf.Connect = ";DATABASE=" & arg_chemin Tdf.Refreshlink End If Set Tdf = Nothing Var = SysCmd(SYSCMD_UPDATEMETER, I) Next I fRediriger_donnees = True fRediriger_donnees_Exit: Var = SysCmd(SYSCMD_REMOVEMETER) Set Db = Nothing Set Tdf = Nothing Exit Function fRediriger_donnees_Error: fRediriger_donnees = False GoTo fRediriger_donnees_Exit End Function Sub TLPrometheeLocal() fRediriger_donnees ("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Local\testcode.mdb") End Sub Sub TLPrometheeReseau() fRediriger_donnees ("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Réseau\testcode.mdb") End Sub Sub TLDaedalusLocal() fRediriger_donnees ("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Local\BdMultiCritere.mdb") End Sub Sub TLDaedalusReseau() fRediriger_donnees ("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Réseau\BdMultiCritere.mdb") End Sub
Quelqu'un peut'il me mettre sur la voie SVP.
Merci d'avance.
Partager