VBA Excel:添加自动保存行时冻结

我有一个代码，用于检查“保存前”事件用户是否填写必填单元格。 当我试图为自动命名添加give file的附加行时，代码冻结。但是创建文件。下面你可以找到我的代码，大部分代码只是检查单元格，但我不确定错误的原因，所以我添加了所有代码，以防我遗漏了什么

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim message As String
Dim say As Long

say = Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("C:C"))

If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("D:D")) <> say Then
   message = Range("D1").Value & vbCrLf
End If
If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("F:F")) <> say Then
   message = message & Range("F1").Value & vbCrLf
End If

If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("G:G")) <> say Then
   message = message & Range("G1").Value & vbCrLf
End If

If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("H:H")) <> say Then
   message = message & Range("H1").Value & vbCrLf
End If

If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("I:I")) <> say Then
   message = message & Range("I1").Value & vbCrLf
End If

If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("J:J")) <> say Then
   message = message & Range("J1").Value & vbCrLf
End If

If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("K:K")) <> say Then
   message = message & Range("K1").Value & vbCrLf
End If

If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("M:M")) <> say Then
   message = message & Range("M1").Value & vbCrLf
End If

If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("N:N")) <> say Then
   message = message & Range("N1").Value & vbCrLf
End If

If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("Q:Q")) <> say Then
   message = message & Range("Q1").Value & vbCrLf
End If

If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("R:R")) <> say Then
   message = message & Range("R1").Value & vbCrLf
End If

If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("AU:AU")) <> say Then
   message = message & Range("AU1").Value & vbCrLf
End If

If message <> "" Then
   MsgBox "" & message & vbCrLf & "Can’t Save with Empty Cells!!"

Cancel = True
End If


ThisFile = Format(Now(), "yyyy-mm-dd") & "__" & "ACC__" & Range("H2").Value & "__" & "CR"
ActiveWorkbook.SaveAs Filename:=ThisFile & ".xlsx"

End Sub

Private子工作簿\u保存前（ByVal SaveAsUI为布尔值，Cancel为布尔值）
将消息设置为字符串
我说只要
say=Application.WorksheetFunction.CountA（工作表（“ACC REQ”）.范围（“C:C”））
如果Application.WorksheetFunction.CountA（工作表（“ACC REQ”）范围（“D:D”）表示
消息=范围（“D1”）.值和vbCrLf
如果结束
如果Application.WorksheetFunction.CountA（工作表（“ACC REQ”）.范围（“F:F”）表示
消息=消息和范围（“F1”）。值和vbCrLf
如果结束
如果Application.WorksheetFunction.CountA（工作表（“ACC REQ”）范围（“G:G”）表示
消息=消息和范围（“G1”）。值和vbCrLf
如果结束
如果Application.WorksheetFunction.CountA（工作表（“ACC REQ”）范围（“H:H”）表示
消息=消息和范围（“H1”）。值和vbCrLf
如果结束
如果Application.WorksheetFunction.CountA（工作表（“ACC REQ”）.范围（“I:I”）表示
消息=消息和范围（“I1”）。值和vbCrLf
如果结束
如果Application.WorksheetFunction.CountA（工作表（“ACC REQ”）范围（“J:J”）表示
消息=消息和范围（“J1”）。值和vbCrLf
如果结束
如果Application.WorksheetFunction.CountA（工作表（“ACC REQ”）范围（“K:K”）表示
消息=消息和范围（“K1”）。值和vbCrLf
如果结束
如果Application.WorksheetFunction.CountA（工作表（“ACC REQ”）范围（“M:M”）表示
消息=消息和范围（“M1”）。值和vbCrLf
如果结束
如果Application.WorksheetFunction.CountA（工作表（“ACC REQ”）.范围（“N:N”）表示
消息=消息和范围（“N1”）。值和vbCrLf
如果结束
如果Application.WorksheetFunction.CountA（工作表（“ACC REQ”）范围（“Q:Q”）表示
消息=消息和范围（“Q1”）。值和vbCrLf
如果结束
如果Application.WorksheetFunction.CountA（工作表（“ACC REQ”）.范围（“R:R”）表示
消息=消息和范围（“R1”）。值和vbCrLf
如果结束
如果Application.WorksheetFunction.CountA（工作表（“ACC REQ”）.Range（“AU:AU”）表示
消息=消息和范围（“AU1”）。值和vbCrLf
如果结束
如果消息“”则
MsgBox“”&message&vbCrLf&“无法使用空单元格保存！！”
取消=真
如果结束
此文件=格式（现在（），“yyyy-mm-dd”）&“ACC”&“ACC”&“H2”）。值&“ACC”&“CR”
ActiveWorkbook.SaveAs文件名：=此文件和“.xlsx”
端接头

问候

解决方案： 将

Cancel=True

放在过程末尾，以防止Excel因无限循环而冻结

保存文件时，

Workbook\u BeforeSave

事件会在Excel保存文件**之前运行*，与平常一样

这可以通过

Cancel=True

来防止，这在这种情况下是必要的，因为您希望自己将其保存为

SaveAs

如果没有

Cancel=True

，您的

SaveAs

将再次触发

Workbook\u BeforeSave

事件，您的

SaveAs

将再次触发

Workbook\u BeforeSave

事件……等等

---

备选方案（更压缩）： 您的代码应该与上面的更改一起工作，但下面是一种通过删除重复来进一步压缩代码的方法。（另请参见“如何创建一个图形”。）

减小大小是因为使用了

With..End With

并通过静态数组循环以避免重复相同的代码

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Dim msg As String, say As Long, ws As Worksheet, col
  Set ws = Worksheets("ACC REQ")
  With Application.WorksheetFunction
    say = .CountA(ws.Columns("C"))
    For Each col In Array("D","F","G","H","I","J","K","M","N","Q","R","AU")
      If .CountA(ws.Columns(col))<>say Then msg=msg & Range(col & "1") & vbCrLf
    Next col
    Cancel = True  'we don't need Excel to save it
  End With
  If msg <> "" Then
      MsgBox msg, , "Can't Save with Empty Cells!": Exit Sub
  End If
  ActiveWorkbook.SaveAs Format(Now(), "yyyy-mm-dd") _
              & "__ACC__" & Range("H2") & "__CR.xlsx"
End Sub

Private子工作簿\u保存前（ByVal SaveAsUI为布尔值，Cancel为布尔值）
Dim msg为字符串，表示为长，ws为工作表，col
设置ws=工作表（“ACC REQ”）
使用Application.WorksheetFunction
say=.CountA（ws.Columns（“C”））
对于数组中的每个列（“D”、“F”、“G”、“H”、“I”、“J”、“K”、“M”、“N”、“Q”、“R”、“AU”）
如果.CountA（ws.Columns（col））表示msg=msg&Range（col&“1”）&vbCrLf
下一列
Cancel=True'我们不需要Excel来保存它
以
如果是“msg”，则
MsgBox msg，“无法使用空单元格保存！”：退出子菜单
如果结束
ActiveWorkbook.SaveAs格式（现在为（），“yyyy-mm-dd”）_
&“\uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu
端接头

这一次花了我一分钟，但我知道问题出在哪里！您有一个名为BeforSave的事件，在其中保存。这意味着你有自己的事件。这会导致无限循环

这样做：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.EnableEvents = False
Dim message As String
Dim say As Long
Dim ThisFile As String
Dim Path As String

'.. Check stuff ..


Path = "C:\YourPath\YourFolder\"
ThisFile = Format(Now(), "yyyy-mm-dd") & "__" & "ACC__" & Range("H2").Value & "__" & "CR"
ThisWorkbook.SaveAs Filename:=ThisFile & ".xlsm"

Application.EnableEvents = True
Cancel = True

端接头

---

这将解决您的问题，因为它在实际保存期间禁用事件。确保你有

应用程序。EnableEvents=True

否则它根本不会启动。

与你的问题无关：通常当代码中有重复时，有更好的方法来组织它。最好用..结束以及如何循环代码来研究

。现在我已经整理了你的代码（如下），我已经阅读了你的问题，我不确定问题出在哪里，因为你没有说你要添加哪一行，在哪里添加，或者它给你带来了什么错误。也许，如果您尝试使用更多的代码“不管它是什么”，您可能会有更多的运气。除此之外，你的问题还需要更多的信息。（请参阅“”，以及站点的顶级用户提供的信息。）如果您要在If msg“”中添加一个Else并添加最后两行，我相信这将是对OPs问题的回答…：）哦，我知道了。。。。无止境的循环。这是BeforeSave事件，您正在中指定
SaveAs
，这将再次触发BeforeSave事件。您好，ashleedawg，谢谢您的帮助。我的VBA知识是有限的，但感谢链接，我会检查它，并为误解道歉。我正在尝试检查空单元格，然后用预定义的名称保存文件。在我的例子中，“ormat（Now（），“yyyy-mm-dd”）和“ACC”和“Range”（“H2”）和“\uuu-CR.xlsx”@Xabier感谢您的帮助