时间戳

首页 > 解决方案 > 代码多次保存我的文件而不是一次

excel - 代码多次保存我的文件而不是一次

问题描述

我从互联网上获得了一些代码，可以在特定时间自动保存我的文件，创建一个带有日期和时间的新文件。

每秒创建一个随机文件，而不是一个。昨天我创建了 200 个文件。我有一些用于保存的代码，一个在工作簿中执行的每个操作之后，一个用于防止关闭文件，一个用于使用日期和时间名称进行复制。

我知道我有很多保存代码，但不知道删除哪一个来停止每天保存文件 n 次。

我的工作簿中的代码：

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    'If Weekday(Date) = 5 Then
    Application.OnTime TimeValue("23:30:00"), "copySheets"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'Step 1: Check to see if cell C7 is blank
    If sheets("Trailers").Range("Z1").Value = "" Then
    'Step 2: If cell is blank, cancel the close and tell user
        Cancel = True
        MsgBox "NOPE !!!"
    'Step 3: If cell is not blank, save and close
    Else
        ActiveWorkbook.Close SaveChanges:=True
    End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Application.DisplayAlerts = True
End Sub

Private Sub Workbook_WindowResize(ByVal Wn As Window)
    Wn.WindowState = xlMaximized
    ActiveWindow.EnableResize = False
End Sub

我的模块中用于创建带有日期和时间的新文件的代码。

Sub copySheets() 

    Dim wkb As Excel.Workbook
    Dim newWkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim newWks As Excel.Worksheet
    Dim sheets As Variant
    Dim varName As Variant
    '------------------------------------------------------------
     'Clearing all the values every Saturday
     'If Weekday(Date) = 7 Then
     'Worksheets("Trailers").Range("A3:D307").ClearContents
     'Worksheets("Trailers").Range("G3:G307").ClearContents
     ' Worksheets("Trailers").Range("J3:J307").ClearContents
      ' Worksheets("Trailers").Range("M3:M307").ClearContents
       ' Worksheets("Trailers").Range("P3:P307").ClearContents
       ' End If
       ' Application.OnTime TimeValue("23:30:00"), "copySheets"
    'Define the names of worksheets to be copied.
    sheets = VBA.Array("Trailers")

    'Create reference to the current Excel workbook and to the destination workbook.
    Set wkb = Excel.ThisWorkbook
    Set newWkb = Excel.Workbooks.Add

    For Each varName In sheets

        'Clear reference to the [wks] variable.
        Set wks = Nothing

        'Check if there is a worksheet with such name.
        On Error Resume Next
        Set wks = wkb.Worksheets(VBA.CStr(varName))
        On Error GoTo 0

        'If worksheet with such name is not found, those instructions are skipped.
        If Not wks Is Nothing Then
            'Copy this worksheet to a new workbook.
            Call wks.Copy(newWkb.Worksheets(1))

            'Get the reference to the copy of this worksheet and paste
            'all its content as values.
            Set newWks = newWkb.Worksheets(wks.Name)

        End If

    Next
    'ActiveWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & Format(Now(), "YYYYMMDD") & " Forecasting" & ".xlsm"
    Application.DisplayAlerts = False
    ActiveWorkbook.ActiveSheet.Name = "report"
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "report " & Format(CStr(Now()), "dd-mmm (hh.mm.ss AM/PM)") & ".xlsx"
    Application.DisplayAlerts = False
    ActiveWorkbook.Close SaveChanges:=True

End Sub

标签： excelvba

解决方案

您的问题很可能是这样的：

ActiveWorkbook.Close

在你的Workbook_BeforeClose潜艇内。

before close sub 的工作方式是运行 sub 中的代码，然后自动关闭。

问题是在子中，您还指定再次关闭它。这意味着它将重新启动另一个关闭序列，再次运行子程序，再次遇到关闭线并且......你有一个重复循环。如果您替换Activeworkbook.Close为Activeworkbook.Save它将确保您的更改已保存，并且工作簿将在 sub 结束时自动关闭。

相关答案

推荐阅读