Excel VBA 工作表更改事件导致消息框出现多次

Excel VBA Worksheet Change Event Causes Message Box to Appear Multiple Times

下面的代码检查以确保某个单元格在将颜色更改回 sheet 的原始颜色之前具有值。通过将颜色从黄色更改为 sheet 的原始颜色,用户可以进行打印。问题是,一旦输入值,当表单上的其他任何内容发生更改时,消息框都会继续出现。消息框应该放在 worksheet 更改事件之外吗?我是编程新手,非常感谢您的帮助!

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="Anthem"
  If Range("G50").Value <> "" Then
    MsgBox "You may now print"
    Range("G50").Interior.Color = RGB(221, 235, 247)
  End If
ActiveSheet.Protect Password:="Anthem", AllowFormattingRows:=True
End Sub

谢谢,

安东尼

在您的代码中禁用事件

    Private Sub Worksheet_Change(ByVal Target As Range)
application.enableevents=false    
ActiveSheet.Unprotect Password:="Anthem"
      If Range("G50").Value <> "" Then
        MsgBox "You may now print"
        Range("G50").Interior.Color = RGB(221, 235, 247)
      End If
    ActiveSheet.Protect Password:="Anthem", AllowFormattingRows:=True
application.enableevents=true
    End Sub

首先,每当有变化时,停止protecting/unprotecting工作sheet。将此代码与Worksheet_Change和运行一起放在作品sheet的私有代码sheet中。

private sub protectOnce()
    me.Unprotect Password:="Anthem"
    me.Protect Password:="Anthem", AllowFormattingRows:=True, UserInterfaceOnly:=True
end sub

现在您可以使用 VBA 对作品sheet 做任何您想做的事,而无需取消保护。如果您在其他任何地方有 protect/unprotect,请立即删除它;不需要。

现在,开始您的实际问题。只要在 Range("G50") 发生变化时限制消息框动作,而不是在不相关的变化时。

Private Sub Worksheet_Change(ByVal Target As Range)
    if not intersect(Range("G50"), target) is nothing then
        If Range("G50").Value <> "" Then
            MsgBox "You may now print"
            Range("G50").Interior.Color = RGB(221, 235, 247)
        end if
    End If
End Sub

你可以试试这个。只有更改 G50 才会触发:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.DisplayAlerts = False
    ActiveSheet.Unprotect Password:="Anthem"
    If Target.Address = Target.Worksheet.Range("G50").Address Then
        If Range("G50") <> vbNullString Then
            MsgBox "You may now print"
            Range("G50").Interior.Color = RGB(221, 235, 247)
        End If
    End If
    ActiveSheet.Protect Password:="Anthem", AllowFormattingRows:=True
    Application.DisplayAlerts = True
End Sub