保存特定的文件名和格式

我想问你的这个代码的帮助：

Option Explicit Private WithEvents App As Excel.Application Private Sub Workbook_Open() Set App = Application End Sub Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean) App.EnableEvents = False With App.Dialogs(xlDialogSaveAs) Call .Show(MakeDocName, xlOpenXMLWorkbookMacroEnabled) End With App.EnableEvents = True Cancel = True End Sub Function MakeDocName() As String Dim theName As String Dim pName As String Dim pUName As String pName = Sheets("DESCRIPTION").Range("b4") pUName = UCase(pName) theName = pUName & " RN " & Sheets("DESCRIPTION").Range("b2") MakeDocName = theName End Function 

基本上我期望从这个代码是可以保存指定的名称和格式的文件。 该名称直接从“描述”表单中获取。 格式应该是.xlsm。

问题是，该代码不仅在ThisWorkbook中，而且在所有打开的Excel文件中都有效。

有没有机会使这个代码仅适用于包含代码的指定文件？

Answer 1

你只需要在事件开始时用这样的东西来testingWb对象：

 If Wb <> ThisWorkbook Then Exit Sub 'Or If Wb.Name <> ThisWorkbook.Name Then Exit Sub 

或者，您可以将Workbook_BeforeSave的代码放在ThisWorkBook模块的Workbook_BeforeSave中，这样只会触发此工作簿！ ;）

---

这里是你的完整代码：

 Option Explicit Private WithEvents App As Excel.Application Private Sub Workbook_Open() Set App = Application End Sub Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean) If Wb <> ThisWorkbook Then Exit Sub 'If Wb.Name <> ThisWorkbook.Name Then Exit Sub App.EnableEvents = False With App.Dialogs(xlDialogSaveAs) Call .Show(MakeDocName, xlOpenXMLWorkbookMacroEnabled) End With App.EnableEvents = True Cancel = True End Sub Function MakeDocName() As String Dim theName As String Dim pName As String Dim pUName As String pName = Sheets("DESCRIPTION").Range("b4") pUName = UCase(pName) theName = pUName & " RN " & Sheets("DESCRIPTION").Range("b2") MakeDocName = theName End Function 

Answer 2

您可以使用

 ActiveWorkbook.SaveAs _ Filename:="C:\Allpath\YourFileName", _ FileFormat:= 'HereYourFileFormat" _ CreateBackup:=False 

在这里看看fileformats这些是excel2003的文件格式types：

 xlCSV xlCSVMSDOS xlCurrentPlatformText xlDBF3 xlDIF xlExcel2FarEast xlExcel4 xlAddIn xlCSVMac xlCSVWindows xlDBF2 xlDBF4 xlExcel2 xlExcel3 xlExcel4Workbook xlExcel5 xlExcel7 xlExcel9795 xlHtml xlIntlAddIn xlIntlMacro xlSYLK xlTemplate xlTextMac xlTextMSDOS xlTextPrinter xlTextWindows xlUnicodeText xlWebArchive xlWJ2WD1 xlWJ3 xlWJ3FJ3 xlWK1 xlWK1ALL xlWK1FMT xlWK3 xlWK3FM3 xlWK4 xlWKS xlWorkbookNormal xlWorks2FarEast xlWQ1 xlXMLSpreadsheet 

Answer 3

最后我find了解决办法。 我刚刚删除了应用程序事件，并在ThisWorkbook模块中使用了下面的代码。

 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Application.EnableEvents = False If Application.ThisWorkbook.Path = "" Then With Application.Dialogs(xlDialogSaveAs) Call .Show(MakeDocName, xlOpenXMLWorkbookMacroEnabled) End With Else Application.ThisWorkbook.Save End If Cancel = True End Sub Function MakeDocName() As String Dim theName As String Dim pName As String Dim pUName As String Dim uscore As String uscore = "_" pName = Sheets("DESCRIPTION").Range("b4") pUName = UCase(pName) theName = pUName & " RN " & Sheets("DESCRIPTION").Range("b2") MakeDocName = theName End Function