2016-07-05 65 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