Disable Shift Key

[علي المصري]

جربت الكثير من الاكواد لتعطيل أو إلغاء مفتاح  Shift ولم يفلح أي منها

 

واخيرا نتيجة البحث وجد الكود التالي

Option Compare Database

Option Compare Database
Public Function RunAtStart()
'    KillIt
    DetermineByPass

End Function

Public Function KillIt() As Integer

If SysCmd(SYSCMD_RUNTIME) = 0 Then
 MsgBox ("This Application cannot be opened directly with Microsoft Access," & vbCrLf & _
 "and can ONLY be opened with the desktop shortcut." & vbCrLf & vbCrLf & _
 "Please double click the shortcut on your desktop to open This Application." & vbCrLf & vbCrLf & _
  "This application will now close."), vbOKOnly, "My Application Name"
        Application.Quit
    End If
End Function

Public Function DetermineByPass()
    If Len(Dir(CurrentProject.Path & "\LetMeIn.txt")) = 0 Then
        SetStartupProperties (False)
    Else
        SetStartupProperties (True)
    End If
End Function

Public Sub SetStartupProperties(bolParameter As Boolean)

    ChangeProperty "StartupShowDBWindow", dbBoolean, bolParameter
    ChangeProperty "AllowBreakIntoCode", dbBoolean, bolParameter
    ChangeProperty "AllowSpecialKeys", dbBoolean, bolParameter
    ChangeProperty "AllowBypassKey", dbBoolean, bolParameter
    ChangeProperty "StartupShowStatusBar", dbBoolean, bolParameter
    ChangeProperty "AllowBuiltinToolbars", dbBoolean, bolParameter
    ChangeProperty "AllowFullMenus", dbBoolean, bolParameter
    ChangeProperty "AllowShortcutMenus", dbBoolean, bolParameter

End Sub

Public Function ChangeProperty(strPropName As String, varPropType As Variant, _
varPropValue As Variant) As Integer
    Dim dbs As Database, prp As Property
    Const conPropNotFoundError = 3270

    Set dbs = CurrentDb
    On Error GoTo Change_Err
    dbs.Properties(strPropName) = varPropValue
    ChangeProperty = True

Change_Bye:
    Exit Function

Change_Err:
    If Err = conPropNotFoundError Then  ' Property not found.
        Set prp = dbs.CreateProperty(strPropName, _
        varPropType, varPropValue)
        dbs.Properties.Append prp
        Resume Next
    Else
        ' Unknown error.
        ChangeProperty = False
        Resume Change_Bye
    End If
End Function


 'Add an AutoExec and set it to RunCode - RunAtStart()

 اعمل ماكرو  AutoExec  واكتب الامر التالي   RunCode  ثم اكتب   RunAtStart()

 

انا جربته على اكسيس 2013

[ابو جودي]

رجاء استاذ على وضع مثال لانى حاولت تنفيذ الكود ولكن يظهر لى خطأ

[علي المصري]

لابد من وضع الكود في موديول جديد

ثم عمل ماكرو AutoExec 

RunCode

يتم كتابة اسم الدالة

RunAtStart()

لا تنسى قراءة آخر سطرين في الكود

Shift.txt

[ابو جودي]

نفذت بالظبط وظهر لى الخطأ ده وعلى فكره نفذت اللى حضرتك قولت عليه ده امبارح كمان

[علي المصري]

انا استخدمت الكود مع المرفق

جرب عند التشغيل الضغط على shift

 

test.rar