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

时间:2015-11-19 13:29:13

标签: excel vba save save-as

我想请你帮忙解释一下这段代码:

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”表。格式应为.xlsm。

问题是该代码不仅可以在ThisWorkbook中工作,还可以在所有打开的Excel文件中工作。

是否有机会仅将此代码用于包含代码的指定文件?

3 个答案:

答案 0 :(得分:0)

你只需要在事件开始时用这样的东西测试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

答案 1 :(得分:0)

您可以使用

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

答案 2 :(得分:0)

最后我找到了解决方案。 我刚删除了应用程序事件,并在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