office交流網(wǎng)--QQ交流群號及微信交流群

Access培訓(xùn)群:792054000         Excel免費(fèi)交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

微信交流群(請用微信掃碼)

        

access設(shè)置綁定控件不可以修改內(nèi)容,非綁定控件可修改

2019-09-21 17:17:00
tmtony8
原創(chuàng)
5518

在access數(shù)據(jù)綁定的窗體的中,由於窗體數(shù)據(jù)是直接綁定到記録源的,不需要通過按鈕或者其他方式卽可修改添加數(shù)據(jù)

這樣非常容易意外操作數(shù)據(jù),導(dǎo)緻數(shù)據(jù)齣錯(cuò)。

窗體的AllowEdits屬性設(shè)置爲(wèi)FALSE可以防止這種情況齣現(xiàn),但是這樣鎖定會(huì)把所有控件都設(shè)置爲(wèi)不可修改瞭。

下麵示例可以限製窗體的控件內(nèi)容是否可以直接修改。如果是未綁定控件,可以修改。如果是綁定控件卽不可以修改


詳細(xì)代碼如下:

Public Function LockBoundControls(frm As Form, bLock As Boolean, ParamArray avarExceptionList())
    On Error GoTo Err_Handler
'    Purpose:   Lock the bound controls and prevent deletes on the form any its subforms.
'    Arguments  frm = the form to be locked
'    bLock = True to lock, False to unlock.
'    avarExceptionList: Names of the controls NOT to lock (variant array of strings).
'    Usage:     Call LockBoundControls(Me. True)
    Dim ctl As Control      'Each control on the form
    Dim lngI As Long        'Loop controller.
    Dim bSkip As Boolean
    
'    Save any edits.
    If frm.Dirty Then
        frm.Dirty = False
    End If
'    Block deletions.
    frm.AllowDeletions = Not bLock
    
    For Each ctl In frm.Controls
        Select Case ctl.ControlType
        Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox, acOptionButton, acToggleButton
'            Lock/unlock these controls if bound to fields.
            bSkip = False
            For lngI = LBound(avarExceptionList) To UBound(avarExceptionList)
                If avarExceptionList(lngI) = ctl.Name Then
                    bSkip = True
                    Exit For
                End If
            Next
            If Not bSkip Then
                If HasProperty(ctl, "ControlSource") Then
                    If Len(ctl.ControlSource) > 0 And Not ctl.ControlSource Like "=*" Then
                        If ctl.Locked <> bLock Then
                            ctl.Locked = bLock
                        End If
                    End If
                End If
            End If
            
        Case acSubform
'            Recursive call to handle all subforms.
            bSkip = False
            For lngI = LBound(avarExceptionList) To UBound(avarExceptionList)
                If avarExceptionList(lngI) = ctl.Name Then
                    bSkip = True
                    Exit For
                End If
            Next
            If Not bSkip Then
                If Len(Nz(ctl.SourceObject, vbNullString)) > 0 Then
                    ctl.Form.AllowDeletions = Not bLock
                    ctl.Form.AllowAdditions = Not bLock
                    Call LockBoundControls(ctl.Form, bLock)
                End If
            End If
            
        Case acLabel, acLine, acRectangle, acCommandButton, acTabCtl, acPage, acPageBreak, acImage, acObjectFrame
'            Do nothing
            
        Case Else
'            Includes acBoundObjectFrame, acCustomControl
            Debug.Print ctl.Name & " not handled " & Now()
        End Select
    Next
    
'    Set the visual indicators on the form.
    On Error Resume Next
    frm.cmdLock.Caption = IIf(bLock, "Un&lock", "&Lock")
    frm!rctLock.Visible = bLock
    
    
Exit_Handler:
    Set ctl = Nothing
    Exit Function
    
Err_Handler:
    MsgBox "Error " & Err.Number & " - " & Err.Description
    Resume Exit_Handler
End Function

Public Function HasProperty(obj As Object, strPropName As String) As Boolean
'    Purpose:   Return true if the object has the property.
    Dim varDummy As Variant
    On Error Resume Next
    varDummy = obj.Properties(strPropName)
    HasProperty = (Err.Number = 0)
End Function


按鈕調(diào)用代碼:

     Dim bLock As Boolean
     bLock = IIf(Me.cmdLock.Caption = "&Lock", True, False)
     Call LockBoundControls(Me, bLock)



當(dāng)按鈕爲(wèi)鎖定時(shí),紅色框內(nèi)的綁定控件內(nèi)容均不能修改,如果未鎖定,卽均可修改。無論是否鎖定,上麵的未綁定文本框控件都可以修改查詢內(nèi)容。

    分享
    文章分類
    聯(lián)繫我們
    聯(lián)繫人: 王先生
    Email: 18449932@qq.com
    QQ: 18449932
    微博: officecn01
    移動(dòng)訪問