Excel VBA 阻止 SaveAs .xlsx

Question

我制作了一套带有宏的记分卡计算器。我将工作簿分发为 .xls 文件。但是，有时用户会将工作簿另存为 .xlsx 文件，从而删除所有 VBA 代码和宏。内置函数显然不再起作用了。

有什么方法可以让标准 Excel SaveAs 函数排除 .xlsx 作为选项？

Answer 1

您可以自己替换标准的 FileSave 对话框。不幸的是，您无法操纵过滤器列表来删除除“.xlsm”和“.xls”之外的任何内容，但您可以捕获选定的文件名并采取相应措施...

建议：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FD As FileDialog, FTyp As Long

    MsgBox "Sub Workbook_BeforeSave"

    ' this Sub will never save, we save through the Dialog box below
    Cancel = True

    ' reference a SaveAs Dialog
    Set FD = Application.FileDialog(msoFileDialogSaveAs)
    FD.Show

    If FD.SelectedItems.Count = 0 Then
        MsgBox "Nothing chosen"
        Exit Sub
    Else
        ' check for proper extension
        If Right(FD.SelectedItems(1), 3) = "xls" Or Right(FD.SelectedItems(1), 4) = "xlsm" Then
            MsgBox "saving as " & FD.SelectedItems(1)

            If Right(FD.SelectedItems(1), 3) = "xls" Then
                ' different enum before Excel 2007
                If Val(Application.Version) < 12 Then
                    FTyp = -4143           ' xls pre-2007
                Else
                    FTyp = 56              ' xls post-2007
                End If
            Else
                FTyp = 52                  ' xlsm post-2007
            End If

            ' we don't want to come here again, so temporarily switch off event handling
            Application.EnableEvents = False
            Me.SaveAs FD.SelectedItems(1), FTyp
            Application.EnableEvents = True

        Else
            MsgBox "selected wrong file format ... not saving"
        End If
    End If

End Sub