A caixa de mensagem aparece em todas as planilhas

Question

Estou usando o seguinte código para preencher uma caixa de mensagem quando a data de hoje é inserida na célula H3. O problema é que a caixa de mensagem está aparecendo em todas as planilhas. Eu só quero na folha em que coloco o código (neste caso, "Folha1") e quero que a mensagem continue aparecendo até que a data seja apagada. Por favor ajude!

Sub Worksheet_Calculate()
Dim myMessage As String

    myMessage = ""

    If Range("H3").Value = Date Then
        If (myMessage <> "") Then myMessage = myMessage & vbCrLf
        myMessage = myMessage & "You have a new message. Delete the date next to the message box to acknowledge this message."

    End If

    If (myMessage <> "") Then MsgBox (myMessage)

End Sub

    

Answer 1

A maneira que eu faria isso é criar uma macro com a sub-rotina que você criou e, em seguida, chamá-la do evento Worksheet_Change na planilha da qual você está trabalhando.

Primeiro: crie uma macro (Desenvolvedor > Macros)

Próximo: coloque seu código na macro adicionando uma variável para passar o nome da planilha.

Sub Worksheet_Calculate(SheetName as String) 
Dim myMessage As String

myMessage = ""

If Sheets(SheetName).Range("H3").Value = Date Then
If (myMessage <> "") Then myMessage = myMessage & vbCrLf
    myMessage = myMessage & "You have a new message. Delete the date next to the message box to acknowledge this message."

End If

If (myMessage <> "") Then MsgBox (myMessage) 
End Sub

Finalmente: Volte para a pasta de trabalho e clique com o botão direito na guia da planilha. Selecione Exibir código e adicione uma sub-rotina Worksheet_Activate () que chama a sub-rotina criada na macro (passando o nome da folha como um parâmetro).

Private Sub Worksheet_Activate()
    Worksheet_Calculate "Sheet1" 
End Sub

Agora, a única vez que a caixa de mensagem aparecerá é se a célula designada na planilha designada tiver os dados designados.