Excel VBA时间炸弹代码故障：天数设置不生效及提前触发变更问题排查

Let's break down your two issues and fix them step by step—these problems are mostly due to outdated date handling logic that doesn't play nice with modern Excel 365's behavior.

First Issue: Expiration Date Stuck at 30 Days No Matter the Constant Change #

Root Cause #

Once the ExpirationDate named range is created in your workbook, the original code will never recalculate the expiration date again. It just reads the existing stored value every time you open the workbook, so changing C_NUM_DAYS_UNTIL_EXPIRATION does nothing unless you reset the stored date.

Fixes #

1. Manual Reset (One-Time)
   • Go to the Formulas tab → Name Manager
   • Find ExpirationDate in the list, select it, and click Delete
   • Reopen the workbook (or run the macro manually) and it will use your new constant value to calculate a fresh expiration date
2. Auto-Reset Option (Optional)
   If you want the macro to overwrite the existing date whenever you change the constant, add a line to delete the old name before creating a new one:

   ' Add this right before checking if the name exists
   On Error Resume Next
   ThisWorkbook.Names("ExpirationDate").Delete
   On Error GoTo 0
   

Second Issue: Future Expiration Date Triggers Read-Only Immediately #

Root Causes #

The original code has two critical flaws in how it handles dates:

1. Buggy Date Calculation: Using DateSerial(Year(Now), Month(Now), Day(Now) + X) can break when the day + X exceeds the current month's total days (e.g., May 31 + 30 days would try to create May 61, which Excel mishandles in unexpected ways).
2. Fragile String-Based Date Storage: Storing the date as a formatted short date string and parsing it with Mid() leads to errors if your system's date format doesn't match what Excel stores (e.g., DD/MM/YYYY vs MM/DD/YYYY mixups).

Fixed Full Code #

Replace your original macro with this revised version—it fixes both issues and works reliably in Excel 365:

Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 30 ' Adjust this value as needed

Sub TimeBombMakeReadOnly()
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' TimeBombMakeReadOnly
    ' Stores expiration date in a hidden named range; locks workbook to read-only if expired
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim ExpirationDate As Date
    Dim NameExists As Boolean
    Dim existingName As Name
    
    ' Check if the expiration date name already exists
    On Error Resume Next
    Set existingName = ThisWorkbook.Names("ExpirationDate")
    On Error GoTo 0 ' Reset error handling
    
    If existingName Is Nothing Then
        ' Create new expiration date using reliable date addition
        ExpirationDate = DateAdd("d", C_NUM_DAYS_UNTIL_EXPIRATION, Date)
        ' Store as raw date value (no formatting) to avoid parsing errors
        ThisWorkbook.Names.Add Name:="ExpirationDate", _
            RefersTo:=ExpirationDate, _
            Visible:=False
        NameExists = False
    Else
        ' Read existing date directly from the range (no string parsing)
        ExpirationDate = existingName.RefersToRange.Value
        NameExists = True
    End If
    
    ' Check if we've passed the expiration date
    If Date >= ExpirationDate Then
        If Not NameExists Then
            ThisWorkbook.Save ' Save to retain the new named range
        End If
        ThisWorkbook.ChangeFileAccess xlReadOnly
    End If
End Sub

Key Improvements Explained #

• Reliable Date Calculation: DateAdd("d", X, Date) safely adds X days to the current date, automatically handling month/year rollovers correctly.
• Raw Date Storage: We store the date as a native Excel date value instead of a formatted string, so there's no risk of misparsing due to regional date settings.
• Simplified Comparison: Using Date (which only includes the calendar date, no time) instead of Now avoids edge cases where the time component could trigger a false "expired" flag.

Bonus: Auto-Run on Workbook Open #

Make sure the macro runs every time someone opens the workbook by adding this to the ThisWorkbook module:

Private Sub Workbook_Open()
    TimeBombMakeReadOnly
End Sub

内容的提问来源于stack exchange，提问作者Kennedy