僅在第一次打開電子表格時運行代碼

Question

我希望在每天第一次打開電子表格時運行宏。

多人將全天打開電子表格，我不希望每次有人打開文件時都運行它。 它目前設置為每次打開后運行 1 分鍾，並且確實有效。

這就是我所擁有的：

在一個模塊中：

Sub SingleLevelSort()

ActiveSheet.Unprotect Password:="VANS01"

Worksheets("Portfolio Tracker").Sort.SortFields.Clear
 
Range("A2:BA5000").Sort Key1:=Range("F3"), Header:=xlYes

ActiveSheet.Protect Password:="VANS01", AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, DrawingObjects:=True, Scenarios:=False, AllowDeletingRows:=True

Call Workbook_Open

End Sub

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:01:00"), "SingleLevelSort"
End Sub

在本工作簿中：

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:01:00"), "SingleLevelSort"
End Sub

Answer 1

因此，您可以有一個隱藏的工作表，每次用戶打開工作簿時，代碼都會針對今天的日期搜索 1，如果兩個條件都滿足，它將不會運行代碼。 如果給定日期不是今天的日期，它將用今天的日期覆蓋單元格值。

您可以使用以下代碼，但請確保在 Range("A1") 中添加今天的日期，在 Range("B1") 中添加 1

Private Sub Workbook_Open()

Dim ws as worksheet

Set ws = Thisworkbook.Worksheet("Sheet1") ' add your hidden sheet name in place of sheet1

If Cells(1,1).value <> Date() then
ws.Cells(1,1).value = Date()
ws.Cells(1,2).value = "1"
Application.OnTime Now + TimeValue("00:01:00"), "SingleLevelSort"
Else
Exit  sub
End if
End Sub 

如果您需要對代碼進行任何說明，請告訴我。

Answer 2

一種解決方案是將Name添加到Application.Names集合中，可以在打開工作簿時對其進行測試。

放入本工作簿

Private Sub Workbook_Open()
    Run "RunOnceDaily"
End Sub

放置在一個模塊中

Sub RunOnceDaily()
On Error GoTo ExitSub
    
    Dim LastDayRun As String
    Dim Today As String: Today = Replace(Trim(Date), "/", "") ' Date is an internal function
    
    For Each Item In Application.Names
        If Left(Item.Name, 10) = "LastRunDay" Then
            LastDayRun = Item.Name
            'Application.Names.Item(Item.Name).Delete  ' use to reset Workbook (comment loop block below out)
        End If
    Next
    If Right(LastDayRun, Len(Today)) <> Today Or LastDayRun = "" Then
        Call RunDaily
        Call Application.Names.Add("LastRunDay" & Today, RefersTo:=True, Visible:=False)
        If LastDayRun <> "" Then Application.Names.Item(LastDayRun).Delete
        Application.DisplayAlerts = False
            ThisWorkbook.Save
        Application.DisplayAlerts = True
    End If
    'Debug.Print "Macro Processed"

ExitSub:
End Sub

Private Function RunDaily()
    Debug.Print "Run Once Daily Completed"
End Function

---

您可能希望將工作簿的Name添加和保存移動到RunDaily function，因此只有在該宏完全完成后才會添加它（您可以為其傳遞Today字符串）

Answer 3

Sub Workbook_Open()
    ' First, you want to get the utc
    ' regardless of user localization.
    ' https://stackoverflow.com/a/1600912/5332500
    
    Dim dt As Object, utc As Date
    Set dt = CreateObject("WbemScripting.SWbemDateTime")
    dt.SetVarDate Now
    utc = DateValue(dt.GetVarDate(False))
    
    ' Then check if the wb has been opened today
    If ThisWorkbook.Names("LastOpenedOn") = "=" & CLng(utc) Then
        Debug.Print "wb was opened."
    Else
        ThisWorkbook.Names("LastOpenedOn").RefersTo = utc
        Debug.Print "wb opened first time today."
        
        ' Finally you should save the workbook immediately
        ' after running the macro first time for the day.
        ThisWorkbook.Save
    End If
        
End Sub