\'1  Change Cells(1,1) BeforeSave

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    
     T = Format(Now, \"yyyy-mm-dd hh:mm:ss AM/PM\")
     Sheet1.Activate
     Cells(1, 1) = \"Last Updated Date: \" & T
    
    
End Sub

\'2 change the filename beforeSave

 

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     On Error Resume Next
     Application.DisplayAlerts = False
     Fold = ThisWorkbook.FullName
     Fpath = ThisWorkbook.Path
     ThisWorkbook.Save
     Application.DisplayAlerts = False
    
     T = Format(Now, \"yyyymmdd_hh:mm AM/PM\")
     T = Replace(T, \":\", \".\")
     T = Replace(T, \" \", \"\")
    
     Temp = Left(ThisWorkbook.Name, 25)
    
     Fname = Fpath & \"\\\" & Temp & T & \"-Subfile.xlsm\"
     ThisWorkbook.ChangeFileAccess xlReadOnly
     Name Fold As Fname
     Application.Workbooks.Open Fname, False
     ThisWorkbook.Close False
     Application.DisplayAlerts = False
     Cancle = False
    
End Sub


    

收藏 打印