VBA代码覆盖保护设置-任何想法

时间:2019-01-29 06:48:51

标签: excel vba

我有一个工作表,当业务代表填写表格并点击提交时,它会解锁工作表,添加数据行,然后锁定工作表。

问题是我需要添加在仍受保护的情况下解锁“排序”和“自动过滤”选项的功能。

我正在使用Microsoft Excel 365。

我尝试手动解锁选项以及添加Dim语句,但是没有任何效果。我继续收到“不匹配类型”错误

Private Sub cmdUpdate_Click()        
    Application.Calculation = xlCalculationManual
    Sheets("Appointment Log").Select
    ActiveSheet.Unprotect Password:="asdf"

    Dim lastrow
    Dim currentrow As Long
    Dim LookUpID As Double
    Dim RecordNumber As Double
    RecordNumber = 0

    'Data Validations:
    If Me.cmbCategory.Value = "" Then
        MsgBox "Please enter Category"
        Me.cmbCategory.SetFocus
        Exit Sub
    End If

    If Me.txtLookUpID.Value = "" Then
        MsgBox "Please enter ID"
        Me.txtLookUpID.SetFocus
        Exit Sub
    End If

    LookUpID = txtLookUpID.Text
    LookUpCategory = cmbCategory.Text

    lastrow = 2 + Range("A2").Value        

    ' searching for record number and assigning it to RecordNumber variable
    For currentrow = 3 To lastrow
        If Cells(currentrow, 5).Text = LookUpID And Cells(currentrow, 2).Text = LookUpCategory Then
            If Cells(currentrow, 1).Value > RecordNumber Then
                RecordNumber = Cells(currentrow, 1).Text               
            End If
        End If        
    Next currentrow

    If RecordNumber = 0 Then
        MsgBox ("Cannot find ID")
    End If

    'Searching for record and updating it    
    For currentrow = 3 To lastrow        
        If Cells(currentrow, 1).Text = RecordNumber Then
            Cells(currentrow, 12).Value = Me.cmbFollowUpResult
            Cells(currentrow, 13).Value = Date
            Cells(currentrow, 14).Value = Date            
        End If        
    Next currentrow


    For Each ctl In Me.Controls
        If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
            ctl.Value = ""

        End If
    Next ctl

    If RecordNumber > 0 Then
        Answer = MsgBox("Your Entry was made, Would You like to make another Update Follow Up Result Entry?", vbQuestion + vbYesNo)

        If Answer = vbYes Then
            cmdUpdate_Click
        End If
    End If

    Sheets("Appointment Log").Select

    Application.Calculation = xlCalculationAutomatic

    ActiveSheet.Protect Password:="asdf"

0 个答案:

没有答案