VBA实时检测工作表是否存在，小白求助大神。

excel玉米

醒酒壶 发表于 2022-8-30 22:28
大哥，好像这个也没自动运行，我想要的是检测日期，如果日期变化了代码就自己运行，把新日期的创建出来

不知道你要求的是哪样？你打开我的附件，昨天打开，没有8-31工作表，今天打开，就有8-31工作表了。保存过后再次打开，则跳出对话框提示你，本日已经创建了工作表。打开工作薄时就已经检测日期变化了呀！

醒酒壶

excel玉米 发表于 2022-8-31 08:39
不知道你要求的是哪样？你打开我的附件，昨天打开，没有8-31工作表，今天打开，就有8-31工作表了。保存过 ...

我的要求就是,如果我没有关闭这个文件的情况下，时间过了凌晨的12点，日期变化更新了一天，就执行里面的代码，把新一天的建出来，假设今天8-31，过了凌晨12点就自己运行代码，建出9-1的

excel玉米

醒酒壶 发表于 2022-8-31 21:48
我的要求就是,如果我没有关闭这个文件的情况下，时间过了凌晨的12点，日期变化更新了一天，就执行里面的 ...

这个要求为难人了，也想不到有这样的使用场景。另请高人吧！

醒酒壶

excel玉米 发表于 2022-9-1 08:45
这个要求为难人了，也想不到有这样的使用场景。另请高人吧！

没办法实现的吗？

32004726

在WORKBOOK中贴上，点击右键触发

1. Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
   
2.     Dim N, I As Integer, sht As Worksheet, X As Integer
   
3.     N = WorksheetFunction.Text(Now() - ActiveWorkbook.BuiltinDocumentProperties(12), "D")
   
4.    
   
5.     If N > 0 Then
   
6.    
   
7.    
   
8.         I = ThisWorkbook.Sheets.Count
   
9.    
   
10.         For X = 1 To Sheets.Count
    
11.             If Worksheets(I).Name <> Format(Now(), "m-d") Then
    
12.                 Worksheets(I).Copy after:=Worksheets(I)
    
13.                 I = I + 1
    
14.                 Worksheets(I).Name = Format(Now(), "m-d")
    
15.                 MsgBox "已创建今日工作表" & Worksheets(I).Name
    
16.                 Exit Sub
    
17.             End If
    
18.         Next
    
19.    
    
20.     End If
    
21.    
    
22. End Sub
    

复制代码

32004726

放在thisbook这个工作表对象内，在 VBE界面里的sheet对象下面,用保存前对比上次保存时间与现在时间是否跨天来判断是否增加工作表。

1. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   
2. Dim N, I As Integer, sht As Worksheet, X As Integer
   
3.     N = WorksheetFunction.Text(Now() - ActiveWorkbook.BuiltinDocumentProperties(12), "D")
   
4.    
   
5.     If N > 0 Then
   
6.    
   
7.    
   
8.         I = ThisWorkbook.Sheets.Count
   
9.    
   
10.         For X = 1 To Sheets.Count
    
11.             If Worksheets(I).Name <> Format(Now(), "m-d") Then
    
12.                 Worksheets(I).Copy after:=Worksheets(I)
    
13.                 I = I + 1
    
14.                 Worksheets(I).Name = Format(Now(), "m-d")
    
15.                 MsgBox "发现保存文件时，已跨天，已自动创建今日工作表" & Worksheets(I).Name
    
16.                 Exit Sub
    
17.             End If
    
18.         Next
    
19.    
    
20.     End If
    
21. 
    
22. End Sub
    
23. 
    
24. Private Sub Workbook_Open()
    
25.     Dim I As Integer, sht As Worksheet, X As Integer
    
26.     I = ThisWorkbook.Sheets.Count
    
27.    
    
28.     For X = 1 To Sheets.Count
    
29.         If Worksheets(I).Name <> Format(Now(), "m-d") Then
    
30.             Worksheets(I).Copy after:=Worksheets(I)
    
31.             I = I + 1
    
32.             Worksheets(I).Name = Format(Now(), "m-d")
    
33.             MsgBox "已创建今日工作表" & Worksheets(I).Name
    
34.             Exit Sub
    
35.         End If
    
36.     Next
    
37. End Sub
    
38.    
    

复制代码

32004726

见附件，最优方案，以保存来实现。