以特定文件名和格式保存答案

【问题标题】：Save with specific file name and format以特定文件名和格式保存
【发布时间】：2015-11-19 13:29:12
【问题描述】：

我想就这段代码向您寻求帮助：

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 文件中都有效。

是否有机会使此代码仅可用于包含该代码的指定文件？

【问题讨论】：

您正在接收应用程序事件，在工作簿中执行可能是一个想法 Private WithEvents WB As Excel.Workbook 使用 Private Sub WB_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

标签： excel vba save save-as

【解决方案1】：

你只需要在你的活动开始时测试Wb对象``用这样的东西：

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

或者您可以将App_WorkbookBeforeSave 的代码放在Workbook_BeforeSave 的ThisWorkBook 模块中，这样它就只会被这个工作簿触发！ ;)

这是你的完整代码：

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

【讨论】：

所有这些代码都已经在 ThisWorbook 模块中。出于这个原因，我不明白为什么它也适用于其他人。无论如何，现在我正在尝试你的第一个建议。
所以，只是您的代码在所有工作簿的自定义事件中，您可以从App_WorkbookBeforeSave 获取代码并将其粘贴到Workbook_BeforeSave（您可能需要先创建）你不会有这个问题！ ;)
感谢 R3uK 的帮助。这真的很有帮助。
@Riccardo：很高兴我能帮上忙！ ;) 当您应用我提出的解决方案时，您能验证我的答案吗？并花一分钟时间参观：stackoverflow.com/tour享受！ ;)

【解决方案2】：

你可以使用

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

查看here 的文件格式这些是 excel2003 的文件格式类型：

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

【讨论】：

【解决方案3】：

终于找到了解决办法。我刚刚删除了应用程序事件并在 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

【讨论】：