raspudic Raspudic Zeljko Banja Luka
Član broj: 57314 Poruke: 36 80.87.245.*
|
Ide odgovor sa danom zakašnjenja, bio sam na putu...
Na uvodnu formu svog programa postaviš dugme za koga je Transparent Yes (čisto da se ne vidi da ne bi iritiralo korisnike) i koje se zove recimo bIskljuciShift.
U On Click događaj stavi sljedeće:
Private Sub bIskljuciShift_Click()
On Error GoTo Err_bIskljuciShift_Click
Dim strInput As String
Dim strMsg As String
Beep
strMsg = "Zelite li omoguciti SHIFT key?" & vbCrLf & vbLf & _
"Molimo Vas upisite sifru za omogucivanje SHIFT key-a."
strInput = InputBox(Prompt:=strMsg, Title:="Shift key nije omogucen")
If strInput = "3232" Then
AddCustomConnectionProperty "AllowBypassKey", True
AddCustomConnectionProperty "AllowBreakIntoCode", True
AddCustomConnectionProperty "StartupShowDBWindow", True
AddCustomConnectionProperty "StartupShowStatusBar", True
AddCustomConnectionProperty "AllowBuiltinToolbars", True
AddCustomConnectionProperty "AllowShortcutMenus", True
AddCustomConnectionProperty "AllowBuiltInToolbars", True
AddCustomConnectionProperty "AllowFullMenus", True
AddCustomConnectionProperty "AllowToolbarChanges", True
AddCustomConnectionProperty "AllowSpecialKeys", True
MsgBox "Shift key je ukljucen." & vbCrLf & vbLf & _
"Slijedeci put kad budete otvarali vasu bazu Shift key ce biti omogucen.", _
vbInformation, "Set Startup Properties"
Else
Beep
AddCustomConnectionProperty "AllowBypassKey", False
AddCustomConnectionProperty "AllowBreakIntoCode", False
AddCustomConnectionProperty "StartupShowDBWindow", False
AddCustomConnectionProperty "StartupShowStatusBar", True
AddCustomConnectionProperty "AllowBuiltinToolbars", False
AddCustomConnectionProperty "AllowShortcutMenus", False
AddCustomConnectionProperty "AllowBuiltInToolbars", False
AddCustomConnectionProperty "AllowFullMenus", False
AddCustomConnectionProperty "AllowToolbarChanges", False
AddCustomConnectionProperty "AllowSpecialKeys", False
MsgBox "Sifra nije prihvacena!" & vbCrLf & vbLf & _
"Shift key je onemogucen." & vbCrLf & vbLf & _
"Slijedeci put kad budete otvarali bazu Shift key ce biti onemogucen.", _
vbCritical, "Netacna sifra"
Exit Sub
End If
Exit_bIskljuciShift_Click:
Exit Sub
Err_bIskljuciShift_Click:
MsgBox "bIskljuciShift_Click", err.Number, err.Description
Resume Exit_bIskljuciShift_Click
End Sub
U module neka bude modul koji se recimo zove Shift (čisto zbog preglednosti) i u kome je:
Public Function AddCustomConnectionProperty(strPropName As String, varPropValue As Variant) As Boolean
' Add custom properties to the AccessObjectProperties
' collection that is associated with an AccessObject object.
Const conPropNotFoundError = 3265
On Error GoTo AddProp_Err
With CurrentProject
.Properties(strPropName) = varPropValue
End With
AddCustomConnectionProperty = True
AddProp_Bye:
Exit Function
AddProp_Err:
If err = conPropNotFoundError Or err = 2455 Then
With CurrentProject.Properties
.Add strPropName, varPropValue
End With
Resume
Else
MsgBox err.Description
AddCustomConnectionProperty = False
Resume AddProp_Bye
End If
End Function
Probaj pa javi dali je OK. Meni radi baš kako treba.
Pozdrav Željko
|