Dégradation des performances sur l’ouverture des tables liées.

Lorsque vous ouvrez des tables liées dans Access 2002, 2003 et 2007, il arrive d’observer une dégradation du temps d’ouverture de ces tables. Ce problème se produit si plusieurs tables liées de la base de données contiennent également plusieurs relations et si la propriété « Sous-feuille de données » est placée à [Auto] sur la table en ouverture.

Pour contourner ce problème, définissez la propriété « Sous-feuille de données » de la table à [None]. Vous pouvez effectuer cela manuellement ou par code VBA.

Modification par le code VBA :

·         Sauvegardez votre base de données principale.

·         Ouvrez la base de données principale.

·         Créez un nouveau module standard.

·         Dans le menu Outils, cliquez sur Références. Cochez Microsoft DAO 3.6 et cliquez sur OK.

·         Copiez/collez  le code suivant dans le nouveau module.

·         Ouvrez la fenêtre exécution.

·         Placez le curseur dans le module et enfoncez la touche F5.

Toutes les propriétés SubDataSheetName des tables seront placées à [None]

Compactez la base et fermez-la.


Private Sub subData()
    Dim Db As DAO.Database
    Dim Tbl As DAO.TableDef
    Dim Prp As DAO.Property
    Dim prpName As String
    Dim prpNoneValue As String
    Dim prpAutoValue As String
    Dim prpType As Integer
    Dim I As Integer
    Dim intCount1 As Integer
    Dim intCount2 As Integer
    On Error GoTo tagError
    Set Db = CurrentDb
    prpName = "SubDataSheetName"
    prpType = 10
    prpNoneValue = "[None]"
    prpAutoValue = "[Auto]"
    intCount1 = 0
    intCount2 = 0
    For Each Tbl In Db.TableDefs
        If (Tbl.Attributes And dbSystemObject) = 0 Then
            If Tbl.Properties(prpName) = prpAutoValue Then
                Tbl.Properties(prpName) = prpNoneValue
                intCount1 = intCount1 + 1
            Else
                intCount2 = intCount2 + 1
            End If
        End If
tagResum:
    Next Tbl
    Set Db = Nothing
    If intCount1 > 0 Then
        Debug.Print "la valeur de la propriété " & prpName & " pour " & intCount1 & " tables non-system a été modifiée à " & prpNoneValue & "."
    End If
    If intCount2 > 0 Then
        Debug.Print "la valeur de la propriété " & prpName & " pour " & intCount2 & " tables non-system était déjà à " & prpNoneValue & "."
    End If
    Exit Sub
tagError:
    If err.number = 3270 Then
        Set Prp = Tbl.CreateProperty(prpName)
        Prp.Type = prpType
        Prp.Value = prpNoneValue
        Tbl.Properties.Append Prp
        intCount1 = intCount1 + 1
        Resume tagResum
    Else
        Debug.Print err.Description & vbCrLf & " dans les propriétés de " & Tbl.Name
    End If
End Sub