Excel VBA防止SaveAs .xlsx

我制作了一套带有macros的Scorecard计算器。 我将工作簿分发为.xls文件。 但是,有时用户将工作簿保存为.xlsx文件,从而删除所有的VBA代码和macros。 内置的function显然不再起作用。

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

您可以自己replace标准的FileSave对话框。 不幸的是,你不能操纵filter列表去除除“.xlsm”和“.xls”以外的任何东西,但你可以捕获选定的文件名并相应地执行操作。

build议:

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