Discussion :

[Looping_V60]

Slt à tous,
Voilà le contexte :
Je crée une base de données "archives" à partir de ma base principale , je voudrais également pendant la création régler certains paramètres de cette base archives :

-Cocher la référence "Microsoft DAO 3.6 Object library" dans la liste des références sous Visual Basic.

-Décocher l'option "Afficher la fenêtre base de données" dans "Outils/Démarrage"

-Ajouter un titre personalisé dans la même section "Outils/Démarrage"

Est-ce possible par du code ?

[helas]

Rem * Pour faire disparaitre la fenêtre de base de donnée , indiquer False *

Call ModifiePropr "StartupShowDBWindow", dbBoolean, False

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
 Function ModifiePropr(chNomPropriété As String, varTypeProp As Variant, varValeurProp As Variant) As Integer
 
    Dim bds As DAO.Database, prp As Property
    Const conErreurPropNonTrouvée = 3270
 
    Set bds = CurrentDb
    On Error GoTo Change_Err
 
   bds.Properties(chNomPropriété) = varValeurProp
    ModifiePropr = True
 
Change_Sortie:
    Exit Function
 
Change_Err:
    If Err = conErreurPropNonTrouvée Then   ' Propriété non trouvée.
        Set prp = bds.CreateProperty(chNomPropriété, varTypeProp, varValeurProp)
        bds.Properties.Append prp
        Resume Next
    Else
        ModifiePropr = False
        Resume Change_Sortie
    End If
End Function

Voici ce que j'utilise :
Suivant la version d'acces, je modifie les références
___________________________________________________

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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
 Sub VerificationReferences()
 Dim version As String, Ref As Reference
 
 On Error GoTo erreur
 version  = SysCmd(acSysCmdAccessVer)
 
 Select Case version 
 Case "9.0"
  If Not ReferencePresente("DAO") Then Call CreationReference("DAO")
  If Not ReferencePresente("MSACAL") Then Call CreationReference("MSACAL")
 Case "11.0"
  If Not ReferencePresente("DAO") Then Call CreationReference("DAO")
  If Not ReferencePresente("Office") Then Call CreationReference("Office")
  If Not ReferencePresente("ACTIVEXLib") Then Call CreationReference("ACTIVEXLib")
  If Not ReferencePresente("VBIDE") Then Call CreationReference("VBIDE")
 End Select
 
 Exit Sub
erreur:
 Resume Next
End Sub
 
Function ReferencePresente(s As String) As Boolean
 Dim Ref As Reference
 ReferencePresente = False
 For Each Ref In References
  If Ref.Name = s Then ReferencePresente = True: Exit For
 Next Ref
End Function
 
Function CreationReference(s As String) As Boolean
 Dim version As String, Ref As Reference, Source As String
 On Error GoTo erreur
 
 version  = SysCmd(acSysCmdAccessVer)
 Source  = "C:\Program Files\Fichiers communs\Microsoft Shared\"
 
Select Case version 
 Case "9.0"
 
  Select Case s
  Case "DAO"
   If Dir(Source  & "dao\dao360.dll") <> "" Then Set Ref = References.AddFromFile(Source  & "dao\dao360.dll")
 
  Case "MSACAL"
   If Dir(Source  & "mscal.ocx") <> "" Then Set Ref = References.AddFromFile(Source  & "dao\dao360.dll")
  End Select
 
 Case "11.0"
 
  Select Case s
  Case "DAO"
    If Dir(Source   & "dao\dao360.dll") <> "" Then Set Ref = References.AddFromFile(Source  & "dao\dao360.dll")
 
  Case "Office"
    If Dir(Source   & "Office11\mso.dll") <> "" Then Set Ref = References.AddFromFile(Source  & "Office11\mso.dll")
 
  Case "ACTIVEXLib"
   If Dir(Source   & "AUTHZAX.dll") <> "" Then Set Ref = References.AddFromFile(v & "AUTHZAX.dll")
 
  Case "VBIDE"
   If Dir(Source   & "VBA\VBA6\VBE6EXT.olb") <> "" Then Set Ref = References.AddFromFile(Source  & "VBA\VBA6\VBE6EXT.olb")
 
  End Select
 
 End Select
 Exit Function
erreur:
End Function

Pour le titre de l'application, j'utilise ces 2 lignes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
  CurrentDb.Properties("AppTitle") = NomApplication
 RefreshTitleBar

[Looping_V60]

Merci pour le code,
Je l'ai mis en place et dans l'ensemble ça marche pas mal.

Un seul petit souci avec la function "ModifiePropr" :
Lors de la première exécution (juste après la création de la base), la propriété "StartupShowDBWindow" , n'existe pas , donc le code se dirige vers la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Change_Err:
    If Err = conErreurPropNonTrouvée Then   ' Propriété non trouvée.
        Set prp = bds.CreateProperty(chNomPropriété, varTypeProp, varValeurProp)
        bds.Properties.Append prp
        Resume Next

et lors de l'exécution de la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set prp = bds.CreateProperty(chNomPropriété, varTypeProp, varValeurProp)

une erreur 13 (Incompatibilité de type) se produit , j'en ai déduit que la variable "prp" n'était pas correctement définie , j'ai remplacé (pour essai) par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim bds As DAO.Database, prp As Variant

Cette fois le code fonctionne sans erreur, la propriété "Afficher la fenêtre de la base de données" est bien décochée , mais malgré tout elle est visible à la première ouverture.
Il faut refermer et réouvrir une seconde fois pour que tout soit ok.

j'ai essayé d'ajouter:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Change_Err:
    If Err = conErreurPropNonTrouvée Then   ' Propriété non trouvée.
        Set prp = bds.CreateProperty(chNomPropriété, varTypeProp, varValeurProp)
        bds.Properties.Append prp
        bds.Properties.Refresh
        Resume Next

mais ça ne change rien !

Voilà ma question : que se passe t'il lors de la fermeture d'une base sur les propriétés ? (enregistrement ... ) , comment éviter ce phénomène ??

Merci d'avance à tous