2016-07-05 59 views
1

当前我有此代码。在Column A中,我目前有“是”或“否”选择。当受保护的单元格被点击时显示警告消息

Private Sub worksheet_change(ByVal Target As Range) 

     If Not Intersect(Target, Range("A:A")) Is Nothing Then 

      ActiveSheet.Unprotect 
      If Target = "YES" Then 

       'Column B to S 
       For i = 1 To 18 
        With Target.Offset(0, i) 
         .Locked = False 
         .FormatConditions.Add Type:=xlExpression, Formula1:="=ISBLANK(" & Target.Offset(0, i).Address & ")" 
         With .FormatConditions(.FormatConditions.Count) 
          .SetFirstPriority 
          .Interior.ColorIndex = 4 
         End With 
        End With 
       Next i 

ElseIf Target = "NO" Then 

      For i = 1 To 73 
       With Target.Offset(0, i) 
        .Value = "" 
        .Locked = True 
        .FormatConditions.Delete 

       End With 
      Next i 
      End If 
      ActiveSheet.Protect 

     End If 

    End Sub 

现在,当用户点击Column T(19)的细胞,我想显示一个警告信息给用户,这是不是适用于“是”的选择。

+1

您正在使用[Worksheet_Change](https://msdn.microsoft.com/en-us/library/office/ff839775.aspx)事件宏。如果要捕获选择单元格,您应该使用[Worksheet_SelectionChange](https://msdn.microsoft.com/en-us/library/office/ff194470.aspx)事件宏。在设置保护时,您也可以删除**选择锁定单元**的功能。没有MsgBox,但他们不能选择任何锁定。 – Jeeped

+0

@Jeeped你能举出一个关于这个的示例代码吗?我在VBA中很新。它是否适用于现有的活动? – PeterS

+0

我将不得不重写一些原始的Worksheet_Change。它不处理多个更改(Target可以不只是一个单元格),并且不会关闭事件。给我几分钟。 – Jeeped

回答

1

这似乎应该做你正在问的任务。

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Intersect(Target, Range("A:A")) Is Nothing Then 
     On Error GoTo bm_SafeExit 
     Application.EnableEvents = False 
     Me.Unprotect 
     Dim trgt As Range 
     For Each trgt In Intersect(Target, Range("A:A")) 
      If LCase(trgt.Value2) = "yes" Then 
       With trgt.Offset(0, 1).Resize(1, 18) 
        .Locked = False 
        With .FormatConditions.Add(Type:=xlExpression, Formula1:="=ISBLANK(B" & trgt.Row & ")") 
         .Interior.ColorIndex = 4 
        End With 
       End With 
      Else 
       With trgt.Offset(0, 1).Resize(1, 73) 
        .Value = vbNullString 
        .Locked = True 
        .FormatConditions.Delete 
       End With 
      End If 
     Next trgt 
    End If 

bm_SafeExit: 
    Application.EnableEvents = True 
    Me.Protect Userinterfaceonly:=True 
End Sub 

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    If Not Intersect(Target, Range("T:XFD")) Is Nothing Then 
     On Error GoTo bm_SafeExit 
     Application.EnableEvents = False 
     Dim trgt As Range 
     For Each trgt In Intersect(Target, Range("T:XFD")) 
      If LCase(Me.Cells(trgt.Row, "A").Value2) = "yes" Then 
       MsgBox "Don't try to put Yes here", vbCritical + vbOKOnly, "Bad Choice" 
       Me.Cells(trgt.Row, "A").Select 
      End If 
     Next trgt 
    End If 

bm_SafeExit: 
    Application.EnableEvents = True 

End Sub 

设置手表和断点并使用[F8]和[Ctrl] + [F8}来浏览代码。

+0

非常适合OP的要求。 – skkakkar

相关问题