En poursuivant votre navigation sur ce site, vous acceptez l'utilisation de cookies pour vous proposer des contenus et services adaptés. Mentions légales.

Recherche

Recherche

Les mémos

Je débute...

Visites

 1258988 visiteurs

 6 visiteurs en ligne

Nous contacter

Contact

Désactiver le Shift(2)

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 8153 fois

Vous êtes ici :   Accueil » Désactiver le Shift(2)