Export a single worksheet to a new workbook using VBA and a button

问题

I have a worksheet that has a button, once clicked it will export that sheet into a new workbook and allow the user to save the new workbook to their specified location.

Before upgrading to excel 2016 this code worked fine, but now it's hitting my error handler. I am fairly new to VBA and did not create this code to begin with, so I am not sure if there is an easier way or if I just need to enter a new case for 2016 users and what that new code should say.

Here is the current code:

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

We haven't all been upgraded yet, so I still need 2010 users to be able to export/save but also allow 2016 users to do so. Currently they are just getting the Invalid excel version message.

回答1:

Untested just FYI, but I would combine your identical "Case Statements" by using Case X To Y and increment 15 to 16 which equals Office 2016.

Sources:

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

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

Code:

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

来源：https://stackoverflow.com/questions/56385014/export-a-single-worksheet-to-a-new-workbook-using-vba-and-a-button

标签

excel

vba

button

export

worksheet