Recherche
Recherche
Les mémos
Je débute...
Visites

 998904 visiteurs

 2 visiteurs en ligne

Ce code permet de désactiver ou de réactiver la touche shift de toutes les bases du répertoire courant.

Code écrit par J-Ph CHANCEL (jph.chancel@free.fr) en mai 2006 avec l'aide du code issu de l'excellent site http://www.3stone.be

Fonction pour désctiver l'action de la touche Shift

Function DesactiveShift()
    On Error GoTo errProperty
    'déclarations
    '------------
    Dim Dbs As DAO.Database
    Dim Prp As DAO.Property
    Dim rep As String
    Dim fic As String

    'affectations
    '------------
    rep = Application.CurrentProject.Path

    'traitement
    '----------
    fic = Dir(rep & "*.mdb")
    Do While Len(fic) > 0
        If fic <> CurrentProject.Name Then
            Set Dbs = DBEngine.Workspaces(0).OpenDatabase(rep & fic)
            Set Prp = Dbs.CreateProperty("AllowByPassKey", 1, False)
            Dbs.Properties.Append Prp
            Dbs.Properties("AllowByPassKey") = False
            Set Prp = Nothing
            Dbs.Close
            Set Dbs = Nothing
        End If
        fic = Dir()
    Loop

    'sortie
    '------
    Exit Function

errProperty:
    MsgBox Err.Description

End Function

Fonction pour réactiver l'action de la touche Shift  

Function RéactiveShift()
    On Error GoTo errProperty

    'déclarations
    '------------
    Dim Dbs As DAO.Database
    Dim rep As String
    Dim fic As String

    'affectations
    '------------
    rep = Application.CurrentProject.Path

    'pour les bases dont la fonction shift n'est pas neutralisée
    '-----------------------------------------------------------
    On Error Resume Next

    'traitement
    '----------
    fic = Dir(rep & "*.mdb")
    Do While Len(fic) > 0
        If fic <> CurrentProject.Name Then    'on ne traite pas la base courante
            Set Dbs = DBEngine.Workspaces(0).OpenDatabase(rep & fic)
            Dbs.Properties("AllowByPassKey") = True
            Dbs.Close
            Set Dbs = Nothing
        End If
        fic = Dir()
    Loop

    'sortie
    '------
    Exit Function

errProperty:
    MsgBox Err.Description

End Function


Catégorie : Les mémos - Administration
Page lue 6648 fois