强制模板另存为 xlsm，但之后允许另存为 pdf

Question

我创建了一个 xltm 文档以供我的工作场所使用。大多数用户将 xls 设置为默认保存选项，因此当人们在配置后保存此文档时，他们需要强制另存为 xlsm，否则他们将失去功能。为了覆盖这一点，我使用了以下代码（借用并改编自其他人的问题）：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim vFilename As Variant

'Disable events so "new save" doesn't re-trigger this event
Application.EnableEvents = False

If SaveAsUI = True Then ' User selected SaveAs instead of Save

Cancel = True ' Cancel the user's original save action

'Application.DisplayAlerts = False

'Simulate built in "SaveAs", Use desired "IntialFilename" & filter
vFilename = Application.GetSaveAsFilename(InitialFileName:="C:\Temp\Development.xlsm", fileFilter:="Excel Files (*.xlsm), (*.xlsm")

If vFilename <> False Then

    'Save file with desired parameters
    ThisWorkbook.SaveAs Filename:=vFilename, FileFormat:=xlOpenXMLWorkbookMacroEnabled

End If

Debug.Print vFilename

Application.DisplayAlerts = True

End If

'Re-enable events
Application.EnableEvents = True

End Sub

这按预期工作，强制用户在首次使用模板后另存为 xlsm。但是，由于代码保留在工作表中，这意味着新配置的工作表现在在其整个生命周期和使用期间永远不能保存为 xlsm 以外的任何内容。

这是有问题的，因为在某些时候，用户很可能希望将工作簿中的单个工作表保存为 pdf，以呈现给他们宁愿无法访问实际工作簿的人，并且它是基础公式。

有什么方法可以在用户初始保存到 xlsm 后从文件中删除上面的代码？或者添加到上面的代码以允许保存为 PDF 文件格式？

我意识到一种解决方法是让人们使用“PDF 打印机”（例如 CutePDF）来保存文件，而不是使用内置的保存功能，但这不适合我工作场所的 IT 能力水平。

任何寻求答案的尝试都非常感谢。

Answer 1

选项 1：嵌入一个新的宏/按钮，该宏/按钮将使用代码导出为 PDF。这仍将强制所有手动保存遵守 .xlsm 限制。

Sub ExportToPDF()

    Application.EnableEvents = False 'Prevent the saveas restriction from running

    'Get filename for saving PDF
    Dim vFilename As Variant
    vFilename = Application.GetSaveAsFilename(InitialFileName:="C:\Temp\Development.pdf", fileFilter:="PDF (*.pdf), *.pdf")

    If vFilename <> False Then

        'Export PDF with selected filename
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=vFilename, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

    End If

    Application.EnableEvents = True 'Reset event handler

End Sub

选项 2：修改您的 BeforeSave 子例程以允许 .xlsm 或 .pdf 保存。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim vFilename As Variant

'Disable events so "new save" doesn't re-trigger this event
Application.EnableEvents = False

If SaveAsUI = True Then ' User selected SaveAs instead of Save

Cancel = True ' Cancel the user's original save action

'Application.DisplayAlerts = False

'Simulate built in "SaveAs", Use desired "IntialFilename" & filter
vFilename = Application.GetSaveAsFilename(InitialFileName:="C:\Temp\Development.xlsm", fileFilter:="All Files (*.*), *.*", Title:="Save As: XLSM or PDF Only!") '

If vFilename <> False Then

    'Check to see if user is trying to save as .xlsm, .pdf, or other
    If Right(vFilename, 5) = ".xlsm" Then
        'Save file with desired parameters
        ThisWorkbook.SaveAs Filename:=vFilename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    ElseIf Right(vFilename, 4) = ".pdf" Then
        'Export PDF with selected filename
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=vFilename, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
    Else
        'Alert user and do not save
        MsgBox "This workbook can only be saved in .xlsm or .pdf formats. Please try again."
    End If
End If

Debug.Print vFilename

Application.DisplayAlerts = True

End If

'Re-enable events
Application.EnableEvents = True

End Sub