使用 VBA 将 Excel 文件限制为仅保存为启用宏（.xlsm 或 .xlmt）

Question

我正在尝试使用下面的代码来限制保存和另存为以使用宏保存文件。代码放在“ThisWorkbook”中。

我的主要目标是创建一个带有宏的模板供其他人使用，但是当他们打开模板时，通常会忘记用宏保存它，因为默认设置是 .xlsx 格式。

excel 模板以只读形式放置在 Sharepoint 中。人们然后将副本保存在共享点或服务器上自己的文件夹中。

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

' Declare variables.
Dim FileName As String
Dim FileLocation As String

' Check if the Save As command is being used.
If SaveAsUI = True Then

    ' Create a FileDialog object.
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogSaveAs)

    ' Set the file filter.
    fd.FilterIndex = 2
    fd.Filters.Clear
    fd.Filters.Add "Excel Macro-Enabled Workbook", "*.xlsm"
    fd.Filters.Add "Excel Macro-Enabled Template", "*.xltm"

    ' Display the file dialog box.
    If fd.Show = -1 Then
        FileName = fd.SelectedItems(1)
    Else
        Cancel = True
        Exit Sub
    End If

    ' Save the workbook or template with macros.
    Application.DisplayAlerts = False

    If Right(FileName, 5) = ".xlsm" Then
        ActiveWorkbook.SaveAs Filename:=FileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Else
        ActiveWorkbook.SaveAs Filename:=FileName, FileFormat:=xlOpenXMLTemplateMacroEnabled
    End If

    Application.DisplayAlerts = True

    Cancel = True

End If

End Sub

但是保存时出现此错误：

最后评论截图：

Answer 1

正如我在上面的评论中所写，“FileDialog(msoFileDialogSaveAs)”不接受过滤器。因此，与过滤器相关的所有内容都会引发错误。请改用下一种方式：

Sub testSaveAsFilename()
 Dim fileSaveName As String, fileName As String

 fileName = left(ThisWorkbook.name, InStrRev(ThisWorkbook.name, ".") - 1): Stop

 fileSaveName = Application.GetSaveAsFilename(InitialFileName:=fileName, _
                            FileFilter:="Excel Macro-Enabled Workbook (*.xlsm)," & "*.xlsm, Excel Macro-Enabled Template " & _
                            "Workbook (*.xlst), *xlst", Title:="Save AS  MACRO ENABLED:")
 Debug.Print fileSaveName
End Sub

我没有在你的代码中实现它，但它应该是非常简单的东西，我认为......

而且我还想建议仅使用*.xlsm 作为过滤器。您想让他们将模板保存在自己的计算机上吗？我认为这可能是问题的源泉……我的意思是，如果您修改模板并且他们继续使用已保存的一次。为了使代码让您将其保存为模板，您可以添加第二个以您的用户名为条件的过滤器。

事实上，这样的版本看起来像：

Sub testSaveAsFilenameOnlyXlsm()
 Dim fileSaveName As String, fileName As String, filt As String
 
 fileName = left(ThisWorkbook.name, InStrRev(ThisWorkbook.name, ".") - 1)
 If Application.userName = "your user name" Then
        filt = "Excel Macro-Enabled Workbook (*.xlsm)," & "*.xlsm, Excel Macro-Enabled Template " & _
                "Workbook (*.xlst), *xlst"
 Else
        filt = "Excel Macro-Enabled Workbook (*.xlsm)," & "*.xlsm"
 End If
 
 fileSaveName = Application.GetSaveAsFilename(InitialFileName:=fileName, _
        FileFilter:=filt, Title:="Save AS  MACRO ENABLED:")
                                        
 Debug.Print fileSaveName
End Sub

您可以加密您的用户名并将其放在一个变量中，对于所有不熟练的（在 VBA 中）用户来说不是那么清楚......

回覆已编辑:

上述代码在您的代码事件中实现：

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 Dim fileSaveName As String, FileName As String, filt As String, posDot As Long
 Const yourUserName As String = "your real user name" 'addapt it, please
 
 ' Check if the Save As command is being used.
 If SaveAsUI = True Then
        posDot = InStrRev(ThisWorkbook.Name, ".") 'check if a dot exists in the name (to separate extension)
        If posDot > 0 Then
            FileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
        Else
            FileName = ThisWorkbook.Name
        End If
        If Application.UserName = "Fane Branesti" Then 'for your user name to also allow xltm extension:
               filt = "Excel Macro-Enabled Workbook (*.xlsm)," & "*.xlsm, Excel Macro-Enabled Template " & _
                       "Workbook (*.xltm), *xltm"
        Else
               filt = "Excel Macro-Enabled Workbook (*.xlsm)," & "*.xlsm"
        End If
        
        fileSaveName = Application.GetSaveAsFilename(InitialFileName:=FileName, _
        FileFilter:=filt, Title:="Save AS  MACRO ENABLED:")
        If fileSaveName = "False" Then Cancel = True: Exit Sub

        Application.EnableEvents = False 'disable events after SaveAs
            If Right(fileSaveName, 5) = ".xlsm" Then
                ActiveWorkbook.SaveAs FileName:=fileSaveName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Else
                ActiveWorkbook.SaveAs FileName:=fileSaveName, FileFormat:=xlOpenXMLTemplateMacroEnabled
            End If
        Application.EnableEvents = True 'reenable events
        
        Cancel = True 'stop saving in the standard way
 End If
End Sub