保存特定工作簿时,Excel 会创建一个临时文件,而不是保存数据(不显示错误或警告消息(。症状与本文中所述大致相同:Microsoft Excel-returns-the-error-document-not-saved-after-generatingating-a-2gb-temp-file我尝试了几种解决方案,但决定实施一个解决方法,因为"另存为"工作正常。
下面的代码执行"另存为",基于文件名以值结尾(例如 myFile V1.xlsm(,每次保存工作簿时,宏都会添加一个增量字符(a 到 z(。(例如 myFile V1a.xlsm(。
该宏在标准模块中工作正常,但它会导致 Excel 在移动到"thisWorkbook"时"停止响应"。 我通过将它保留在标准模块中并将组合键"control-s"分配给宏来"解决"这个问题。仍然有兴趣知道它是否可以在"此工作簿"中工作。
此解决方法的缺点是每次增量保存都会阻塞"最近文件"列表。最好从最近的文件历史记录中删除以前的文件名,但这似乎无法通过 VBA 完成。(VBA - 如何在 excel 2007 中从最近的文档列表中删除文件?有什么建议吗?
视窗 10,Excel 2016(版本 16.0.6868.2060(
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim newFilename As String
Dim oldFilename As String
oldFilename = ActiveWorkbook.Name
newFilename = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)
If IsNumeric(Right(newFilename, 1)) = True Then
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "" + newFilename & "a.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else
If Right(newFilename, 1) = "z" Then
MsgBox "'z' reached, please save as new version"
Exit Sub
End If
newFilename = Left(newFilename, Len(newFilename) - 1) & Chr(Asc(Right(newFilename, 1)) + 1)
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "" + newFilename & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
'potential code to remove oldFilename from 'Recent File' list
End Sub
我在Excel 2010中测试了这个Sub,它对我有用。删除文件后,我立即中断了循环,因为我认为索引可能与循环不一致。更精细的变体可能会遍历最近的文件列表并创建要删除的索引集合,然后向后循环访问该集合并依次删除每个条目。
Public Sub RemoveRecentFile(strFileName As String)
Dim collRecentFiles As Excel.RecentFiles
Dim objRecentFile As Excel.RecentFile
Dim intRecentFileCount As Integer
Dim intCounter As Integer
Set collRecentFiles = Application.RecentFiles
intRecentFileCount = collRecentFiles.Count
For intCounter = 1 To intRecentFileCount
Set objRecentFile = collRecentFiles(intCounter)
If objRecentFile.Name = strFileName Then
objRecentFile.Delete
Exit For
End If
Next intCounter
End Sub
感谢罗宾,工作解决方案如下:
更新的初始代码:
Sub incrementSaveAs()
'to avoid that other workbooks are saved (when assigned to shortkey control-S)
If ActiveWorkbook.Name <> ThisWorkbook.Name Then ActiveWorkbook.Save: Exit Sub
Dim newFilename As String
Dim oldFilename As String
oldFilename = ActiveWorkbook.Name
newFilename = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)
If IsNumeric(Right(newFilename, 1)) = True Then
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "" + newFilename & "a.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False, AddToMru:=True
'AddToMru:=True Added to update recent files history
Else
If Right(newFilename, 1) = "z" Then
MsgBox "'z' reached, please save as new version"
Exit Sub
End If
newFilename = Left(newFilename, Len(newFilename) - 1) & Chr(Asc(Right(newFilename, 1)) + 1)
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "" + newFilename & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False, AddToMru:=True
End If
RemoveRecentFile (ActiveWorkbook.Path & Application.PathSeparator & oldFilename)
End Sub
更新了罗宾的代码:
Public Sub RemoveRecentFile(strPathAndFileName As String)
Dim collRecentFiles As Excel.RecentFiles
Dim objRecentFile As Excel.RecentFile
Dim intRecentFileCount As Integer
Dim intCounter As Integer
Set collRecentFiles = Application.RecentFiles
intRecentFileCount = collRecentFiles.Count
For intCounter = 1 To intRecentFileCount
Set objRecentFile = collRecentFiles(intCounter)
If objRecentFile.Path = strPathAndFileName Then
objRecentFile.Delete
Exit For
End If
Next intCounter
End Sub