vba - 如何在不打开的情况下保存用vba编码的excel文件？

Question

我在 Excel 工作表中添加了一个按钮，并在该按钮的 vba 窗口中添加了以下代码。现在，当我单击此按钮时，即当我运行代码时，它会将 Excel 工作表保存为 pdf 格式，其名称取自单元格 H8 并将其保存在 M:\formats 中。此外，它还将相同的 Excel 工作表以 .xlsx 格式保存在 M:\formats\excels 中。但这里的问题是，当我运行代码时，它会关闭我在其中添加代码的 Excel 工作表并打开由代码保存的文件。例如，我制作了 abc.xlsm excel 工作表并在 vb 窗口中添加了代码，现在 xyz 写入 abc.xlsm excel 工作表中的 h8 单元格中，现在当我运行代码时，它会关闭 abc.xlsm 并且所有代码都显示在xyz.xlsx Excel 工作表。我希望它只应将文件以 xlsx 格式保存在必要的位置。它不应关闭基本文件(在上例中为 abc.xlsx)，也不应打开保存的文件(在上例中为 xyz.xlsx)。此外，我希望保存的文件(上例中的 xyz.xlsx)不应包含任何 vba 编码。换句话说，它应该就像基本文件的备份副本(在上面的示例中为 abc.xlsx)。请帮助我将这些代码修改为我想要的。我将非常感谢你。谢谢

Sub ExportAPDF_and_SaveAsXLSX()

Dim wsThisWorkSheet As Worksheet
Dim objFileSystemObject As New Scripting.FileSystemObject

Dim strFileName As String
Dim strBasePath As String

strBasePath = "M:\formats\"
strFileName = Range("H8")

On Error GoTo errHandler

Set wsThisWorkSheet = ActiveSheet

wsThisWorkSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=strBasePath & strFileName, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

MsgBox "PDF file has been created."
strBasePath = "M:\formats\excels\"
strFileName = Range("H8")

Application.DisplayAlerts = False

strFileName = objFileSystemObject.GetBaseName(strFileName) & ".xlsx"

wsThisWorkSheet.SaveAs Filename:=strBasePath & strFileName, 

FileFormat:=xlOpenXMLWorkbook

Application.DisplayAlerts = False

MsgBox "Workbook now saved in XLSX format."


    exitHandler:
    Exit Sub
    errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler

    End Sub

Answer 1

这是代码，只有两个小改动。两组新行前面都有注释“New”。

还稍微整理了错误处理例程。

它的工作原理是这样的:

1. 将当前工作簿的文件名存储在变量“strMasterWorkbookFilename”中

2. PDF 文件是通过“导出”工作表创建的。

3. 然后，Excel 工作表将另存为 XLSX。这实际上“关闭”了原始工作簿。

3.1 按钮(“按钮 8”)从新的 XLSX 工作表中删除，并再次保存工作簿。

然后代码会重新打开原始工作簿 ('strMasterWorkbookFilename') 并关闭当前工作簿。

注释 - 保存为 XLSX 将从保存的文件中删除宏代码。宏将保留在主“主”文件中。

Sub ExportAPDF_and_SaveAsXLSX()

    Dim wsThisWorkSheet As Worksheet
    Dim objFileSystemObject As New Scripting.FileSystemObject

    Dim strFileName As String
    Dim strBasePath As String

    ' NEW
    Dim strMasterWorkbookFilename As String
    strMasterWorkbookFilename = ThisWorkbook.FullName

    strBasePath = "M:\formats\"
    strFileName = Range("H8")

    On Error GoTo errHandler

    Set wsThisWorkSheet = ActiveSheet

    wsThisWorkSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=strBasePath & strFileName, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

        MsgBox "PDF file has been created."

        Application.DisplayAlerts = False
        strFileName = objFileSystemObject.GetBaseName(strFileName) & ".xlsx"
        wsThisWorkSheet.SaveAs Filename:=strBasePath & strFileName, FileFormat:=xlOpenXMLWorkbook
        wsThisWorkSheet.Shapes("Button 8").Delete
        ActiveWorkbook.Save

        Application.DisplayAlerts = False

        MsgBox "Workbook now saved in XLSX format."

        ' NEW
        Workbooks.Open strMasterWorkbookFilename
        Workbooks(strFileName).Close SaveChanges:=False


    exitHandler:
            Exit Sub
    errHandler:
            MsgBox "Error Saving file.  The error is " & vbCrLf & Chr(34) & Err.Description & Chr(34)

            Resume exitHandler

End Sub

感谢您将此作为新问题发布。如果我继续修改第一个问题中的原始代码，那么对于其他阅读您原始帖子的人来说就没有用了。