加载一个XLS文件对于我们放在一起的快速应用程序来说有点痛苦(我们知道如何做到这一点,但它不值得花时间,特别是在C ++中)所以我们将采取简单的方法让用户导出CSV副本。但是为了省去他们的麻烦我想知道我们是否可以拥有一个宏,它会在Excel 2007中保存XLS(X)时自动保存CSV版本?
更新 在Timores的回答之后,我挖了一下并想出了这个:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFileName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
TempFileName = Sourcewb.FullName + ".csv"
'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
'Save the new workbook and close it
With Destwb
.SaveAs Filename:=TempFileName, FileFormat:=xlCSV, ConflictResolution:=xlLocalSessionChanges
.Close SaveChanges:=False
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
除非我无法强制保存CSV,而不是在询问我是否要覆盖,即使在添加ConflictResolution:=xlLocalSessionChanges
答案 0 :(得分:3)
原始版本:
在Excel的VB编辑器部分,在左侧导航菜单中选择“ThisWorkbok”。在右侧的编辑器中,选择左侧下拉列表中的“工作簿”和右侧的“前任”。
将宏替换为:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ActiveWorkbook.SaveCopyAs ActiveWorkbook.FullName + ".csv"
End Sub
这将使用CSV扩展名制作副本。
请注意,XLSX文件不能有宏(您需要XLSM扩展,或者旧的XLS扩展),并且用户需要具有中等或低级别的安全性才能运行宏(或者您必须签署文件。)
已修改版本:
在看到下面的评论后,我再次测试了它。奇怪的是,它没有像第一次那样工作。这是一个固定版本。同样,在宏编辑器的“本工作簿”部分:
Dim fInSaving As Boolean
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If fInSaving Then
Exit Sub
End If
fInSaving = True
Dim workbookName As String
Dim parentPath As String
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
If SaveAsUI Then
Dim result
result = Application.GetSaveAsFilename
If VarType(result) = vbBoolean Then
If CBool(result) = False Then
Exit Sub ' user cancelled the dialog box
End If
End If
workbookName = fs.GetFileName(result)
parentPath = fs.GetParentFolderName(result)
Else
workbookName = ActiveWorkbook.name
parentPath = ActiveWorkbook.path
End If
Dim index As Integer
index = InStr(workbookName, ".")
Dim name As String
name = Left(workbookName, index - 1)
' extension can be empty is user enters simply a name in the 'File / Save as' dialog
' so it is not computed (but hard-coded below)
' do not ask for confirmation to overwrite an existing file
Application.DisplayAlerts = False
' save a copy
ActiveWorkbook.SaveAs fs.BuildPath(parentPath, name & ".csv"), XlFileFormat.xlCSV
' Save the normal workbook in the original name
ActiveWorkbook.SaveAs fs.BuildPath(parentPath, name & ".xlsm"), XlFileFormat.xlOpenXMLWorkbookMacroEnabled
Cancel = True
Application.DisplayAlerts = True
fInSaving = False
End Sub
Private Sub Workbook_Open()
fInSaving = False
End Sub
令人惊讶的是,调用ActiveWorkbook.SaveAs再次触发宏=>用于防止无限递归的全局布尔值。
答案 1 :(得分:2)
避免XL询问是否要覆盖使用Application.DisplayAlerts = False(然后在保存后重置为True)
答案 2 :(得分:0)
由于OP关于保存对话框的问题似乎仍然是开放的,即使查尔斯有关于“真的存储的答案吗?是吗?你确定吗?但该文件存在?无论如何?绝对肯定?”警告,我以为我会分享完整的脚本,警告信息被禁用为完整起见:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFileName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Set Sourcewb = ActiveWorkbook
TempFileName = Sourcewb.FullName + ".csv"
'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
'Save the new workbook and close it
With Destwb
.SaveAs Filename:=TempFileName, FileFormat:=xlCSV, ConflictResolution:=xlLocalSessionChanges
.Close SaveChanges:=False
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub