Excel VBA阻止另存为.xlsx

Question

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

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

Answer 1

您可以用自己的对话框替换标准的FileSave对话框。遗憾的是，除了".xlsm"one_answers".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