使用特定的文件名和格式保存

Question

我想请你帮忙处理这段代码：

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

基本上我对这段代码的期望是可以用指定的名称和格式保存文件。名字直接取自"DESCRIPTION"sheet。格式应为 .xlsm.

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

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

Answer 1

您只需要在事件开始时用类似这样的东西测试 Wb 对象 `` :

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

或者您可以将App_WorkbookBeforeSave的代码放在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

查看 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

Answer 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

使用特定的文件名和格式保存

Save with specific file name and format

excel

vba

save

save-as