如果单元格更改，则同时 Vba SaveAs

Question

我对 VBA 很陌生，非常感谢任何帮助！ 我有一个代码可以在每天 00:10 保存，效果很好，我有一个用于更改单元格的代码，但我不知道如何组合它们...... 如果单元格发生变化，它需要另存为，但要等到 00:10，从保存日期中减去 1 天并另存为，因为温度数据值属于前一天。提前谢谢！

'Cell change is at Sheet2
Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$20" Then
        Call teste 
    End If
If Target.Address = "$G$20" Then
        Call teste
    End If
End Sub

'ThisWorkbook
Private Sub Workbook_Open()
   Application.OnTime TimeValue("00:10:00"), "Abre"
End Sub

'Module1
Sub Abre()
    Application.OnTime TimeValue("00:10:00"), "Abre"
    Dim datestr As String
    datestr = Format(Now, "yyyymmdd, hhmm")
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs "D:\Temperature Data\DailyTemp " & datestr & ".xlsm"
End Sub

'Module2
Sub teste()
MsgBox "Did not work"
End Sub

Answer 1

根据this 的帖子，您可以将参数传递给OnTime 函数。更改您的Abre 以接受日期，该日期可用于保存文件并使用Worksheet_Change 和Abre 本身的适当日期调用它。下面的代码未经测试，但我想你会明白的。要检查的一件事是，如果您的 Worksheet_Change 方法被调用两次会发生什么情况：您是否必须在调用新的之前取消之前的 OnTime？

'Cell change is at Sheet2
Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$20" Then
    Call teste
End If
If Target.Address = "$G$20" Then
    Call teste
End If
Dim datestr As String
datestr = Format(Now, "yyyymmdd, hhmm")
Application.OnTime TimeValue("00:10:00"), procedureCalled, , False
procedureCalled = "'Abre """ & datestr & """'"
Application.OnTime TimeValue("00:10:00"), procedureCalled
End Sub

'ThisWorkbook
Private Sub Workbook_Open()
    Dim datestr As String
    datestr = Format(Now, "yyyymmdd, hhmm")
    procedureCalled = "'Abre """ & datestr & """'"
    Application.OnTime TimeValue("00:10:00"), procedureCalled
End Sub

'Module1
Public procedureCalled As String  '<--variable to keep last scheduled procedure, so you can unshedule it in Worksheet_Change
Sub Abre(savedate As String)
    Dim datestr As String
    datestr = Format(Now, "yyyymmdd, hhmm")
    procedureCalled = "'Abre """ & datestr & """'"
    Application.OnTime TimeValue("00:10:00"), procedureCalled
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs "D:\Temperature Data\DailyTemp " & savedate & ".xlsm"
End Sub

'Module2
Sub teste()
MsgBox "Did not work"
End Sub