Question

我有一个带有按钮的工作表，单击它会将其导出到新工作簿中，并允许用户将新工作簿保存到指定位置。

在升级到excel 2016之前，此代码可以正常工作，但是现在遇到了我的错误处理程序。我对VBA还是很陌生，因此并没有创建此代码，因此我不确定是否有更简单的方法，或者我是否只需要为2016年用户输入一个新案例以及该新代码应该说什么。 >

这是当前代码：

Private Sub SaveIt(SaveName As String)
Dim Fullname As String
Dim FileName As String
Dim Result As String
On Error GoTo ErrHandler

SaveName = SaveName & "\Premium Comparison"
Select Case Int(Application.Version)
  Case 11
   Application.Dialogs(xlDialogSaveAs).Show arg1:=SaveName ', arg2:=56, no arg2 is used in 2003,arg2 is to save 2003 in excel 2010
  Case 14
   Application.DisplayAlerts = False
   Result = Application.Dialogs(xlDialogSaveAs).Show(arg1:=SaveName, arg2:=51)   'xlsx format in 2010
   If Result Then
    Fullname = ActiveWorkbook.Fullname
    FileName = ActiveWorkbook.Name
    Application.Workbooks(FileName).Close SaveChanges:=False
    Application.Workbooks.Open FileName:=Fullname, UpdateLinks:=False
    Application.DisplayAlerts = True
   Else
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
   End If
  Case 15
   Application.DisplayAlerts = False
   Result = Application.Dialogs(xlDialogSaveAs).Show(arg1:=SaveName, arg2:=51)   'xlsx format in 2010
   If Result Then
    Fullname = ActiveWorkbook.Fullname
    FileName = ActiveWorkbook.Name
    Application.Workbooks(FileName).Close SaveChanges:=False
    Application.Workbooks.Open FileName:=Fullname, UpdateLinks:=False
    Application.DisplayAlerts = True
   Else
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
   End If
  Case Else
   MsgBox "Invalid excel version - " & Application.Version
End Select
Workbooks(CWName).Worksheets("Premium Comparison").Protect "Racers"
Exit Sub
ErrHandler:
'User pressed the Cancel button
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Workbooks(CWName).Worksheets("Premium Comparison").Protect "Racers"
Exit Sub
End Sub

我们还没有全部升级，因此我仍然需要2010年的用户能够导出/保存，但还需要2016年的用户才能进行导出/保存。目前，他们只是收到无效的excel版本消息。

Answer 1

未经测试仅是仅供参考，但我将使用Case X To Y将您相同的“案例陈述”组合起来，并将15增大到16（等于Office 2016）。

来源：

https://www.ozgrid.com/VBA/select-case.htm

https://www.rondebruin.nl/win/s9/win012.htm

代码：

Private Sub SaveIt(SaveName As String)
Dim Fullname As String
Dim FileName As String
Dim Result As String
On Error GoTo ErrHandler

SaveName = SaveName & "\Premium Comparison"
Select Case Int(Application.Version)
  Case 11 ' Office 2003
   Application.Dialogs(xlDialogSaveAs).Show arg1:=SaveName ', arg2:=56, no arg2 is used in 2003,arg2 is to save 2003 in excel 2010
  Case 14 to 16 ' Office 2010 --> Office 2016
   Application.DisplayAlerts = False
   Result = Application.Dialogs(xlDialogSaveAs).Show(arg1:=SaveName, arg2:=51)   'xlsx format in 2010
   If Result Then
    Fullname = ActiveWorkbook.Fullname
    FileName = ActiveWorkbook.Name
    Application.Workbooks(FileName).Close SaveChanges:=False
    Application.Workbooks.Open FileName:=Fullname, UpdateLinks:=False
    Application.DisplayAlerts = True
   Else
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
   End If
  Case Else
   MsgBox "Invalid excel version - " & Application.Version
End Select
Workbooks(CWName).Worksheets("Premium Comparison").Protect "Racers"
Exit Sub
ErrHandler:
'User pressed the Cancel button
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Workbooks(CWName).Worksheets("Premium Comparison").Protect "Racers"
Exit Sub
End Sub

使用VBA和按钮将单个工作表导出到新工作簿

1 个答案: