Excel VBA阻止SaveAs .xlsx

时间:2015-02-25 10:11:12

标签: excel excel-vba vba

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

有什么办法可以让标准的Excel SaveAs函数排除.xlsx作为选项吗?

1 个答案:

答案 0 :(得分:2)

您可以自己替换标准的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