VBA - Extracted Worksheet to include VBA Function

[The Great SrH]

Hey,

I'm not entirely sure if this is possible - but i'm hoping you can help me if it is.


I have a Workbook which contains a number of VBA functions built in. The area I want to focus on is the "Extract worksheet" part.


Basically the button will Extract a certain worksheet into a brand new workbook, then send it via Outlook to a recipient.


I'm wondering if there's a way to build in a fixed code to the extracted Worksheet - to include a button which will then give them the option to send this worksheet onto an authoriser?


Any help will be greatly appreciated!


Thanks

 

[John_w]

It is certainly possible to programmatically add a new (form control) button to a sheet and set its OnAction property to a specific macro.

From your macro which extracts the worksheet to the new workbook, you could call something like this Add_Authoriser_Button routine:

Public Sub Add_Authoriser_Button(destSheet As Worksheet)

    Dim btn As Button
    
    'Add a button to the specified sheet and assign Send_Sheet_To_Authoriser as its OnAction macro
    
    Set btn = destSheet.Buttons.Add(263.4, 97.2, 118.8, 37.8)
    With btn
        .OnAction = "Send_Sheet_To_Authoriser"
        .Caption = "Send this sheet to an Authoriser"
        .Name = "btnSendSheet"
    End With
    
    Set btn = Nothing

End Sub

where the destSheet argument is the sheet in the new workbook.

Also add this stub OnAction routine, which you can expand as needed, to your main workbook:

Public Sub Send_Sheet_To_Authoriser()
    MsgBox "Do you want to send this sheet (" & ActiveSheet.Name & ") to an authoriser?"   
End Sub

Of course, the new workbook must be saved as a .xlsm or .xlsb file.

 

[The Great SrH]

It is certainly possible to programmatically add a new (form control) button to a sheet and set its OnAction property to a specific macro.

From your macro which extracts the worksheet to the new workbook, you could call something like this Add_Authoriser_Button routine:

Public Sub Add_Authoriser_Button(destSheet As Worksheet)

    Dim btn As Button
    
    'Add a button to the specified sheet and assign Send_Sheet_To_Authoriser as its OnAction macro
    
    Set btn = destSheet.Buttons.Add(263.4, 97.2, 118.8, 37.8)
    With btn
        .OnAction = "Send_Sheet_To_Authoriser"
        .Caption = "Send this sheet to an Authoriser"
        .Name = "btnSendSheet"
    End With
    
    Set btn = Nothing

End Sub

where the destSheet argument is the sheet in the new workbook.

Also add this stub OnAction routine, which you can expand as needed, to your main workbook:

Public Sub Send_Sheet_To_Authoriser()
    MsgBox "Do you want to send this sheet (" & ActiveSheet.Name & ") to an authoriser?"   
End Sub

Of course, the new workbook must be saved as a .xlsm or .xlsb file.

Thanks so much for the above.

I'm a bit lost where to put this tho! My code for the extract is:

Sub Mail_DFU()
    
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sourcewb = ActiveWorkbook
    'Copy the ActiveSheet to a new workbook
    Sheets("DFU").Visible = True
    Sheets("DFU").Copy
    Set Destwb = ActiveWorkbook
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With
    '    'Change all cells in the worksheet to values if you want
    With Destwb.Sheets(1).UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
            .Cells(1).Select
        End With
        Application.CutCopyMode = False
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "DFU via TW Form - " & Format(Now, "dd-mmm-yy h-mm-ss")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "myemail@email.co.uk"
            .CC = ""
            .BCC = ""
            .Subject = "DFU via TW Form"
            .body = "Hi there"
            .Attachments.Add Destwb.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Sheets("DFU").Visible = False
End Sub

 

[John_w]

Put my code in the same module as your code. Looking at your code, Destwb.Worksheets(1) is the sheet in the new workbook, so you would call my routine like this:

Add_Authoriser_Button Destwb.Worksheets(1)

However, the way you are copying the DFU sheet to a new workbook (the Sheets("DFU").Copy line) means that the VBA module in your macro workbook is not copied to the new workbook, even if you save it as a .xlsm file. You need the module in the new workbook in order to run a macro when the authoriser clicks the "Send this sheet to an Authoriser" button.

Instead of the Copy line, you will need to do a SaveCopyAs to save your macro workbook as a new .xlsm file, open it and delete the sheets you don't want, leaving just the DFU sheet, and send that new .xlsm file to your email recipient.

 

[The Great SrH]

Put my code in the same module as your code. Looking at your code, Destwb.Worksheets(1) is the sheet in the new workbook, so you would call my routine like this:

Add_Authoriser_Button Destwb.Worksheets(1)

However, the way you are copying the DFU sheet to a new workbook (the Sheets("DFU").Copy line) means that the VBA module in your macro workbook is not copied to the new workbook, even if you save it as a .xlsm file. You need the module in the new workbook in order to run a macro when the authoriser clicks the "Send this sheet to an Authoriser" button.

Instead of the Copy line, you will need to do a SaveCopyAs to save your macro workbook as a new .xlsm file, open it and delete the sheets you don't want, leaving just the DFU sheet, and send that new .xlsm file to your email recipient.

Thanks for the information John. I'm sorry, but i'm a bit of an amateur so I'm struggling quite a bit.


How do I get the module into the new workbook? And also you're saying about SaveCopyAs, but I would prefer it all to be automatic as the end user will not know to save it in that way.


Again, I really appreciate all your help - i'm just struggling on how to piece all the codes together.

 

[John_w]

How do I get the module into the new workbook?

By using ThisWorkbook.SaveCopyAs to create a new .xlsm file.

And also you're saying about SaveCopyAs, but I would prefer it all to be automatic as the end user will not know to save it in that way.

SaveCopyAs is VBA code, the user doesn't need to Save As using the Excel UI.

However, the way you are copying the DFU sheet to a new workbook (the Sheets("DFU").Copy line) means that the VBA module in your macro workbook is not copied to the new workbook, even if you save it as a .xlsm file. You need the module in the new workbook in order to run a macro when the authoriser clicks the "Send this sheet to an Authoriser" button.

Instead of the Copy line, you will need to do a SaveCopyAs to save your macro workbook as a new .xlsm file, open it and delete the sheets you don't want, leaving just the DFU sheet, and send that new .xlsm file to your email recipient.

What I wrote above is correct for standard modules, i.e. they are not copied to the new workbook if the new workbook is created using Sheets("Sheet Name").Copy.

I have since discovered that code in the sheet's module IS copied to the new workbook with this method, so in your case there is no need to use SaveCopyAs and your code which uses Sheets("DFU").Copy can be used to create the new workbook.

Therefore see if the following steps work for you (I assume your code is in a standard module):

1. Add this code inside your procedure, immediately after the Application.CutCopyMode = False line:

    'Add button to sheet in new workbook
    
    Add_Authoriser_Button "btnSendSheet", Destwb.Worksheets(1)

2. Add this code to the same module, below your code:

Private Sub Add_Authoriser_Button(buttonName As String, destSheet As Worksheet)

    Dim btn As Button
    
    'Add a button to the specified sheet and assign Send_Sheet_To_Authoriser in the sheet's module as its OnAction macro.  We must
    'specify the name of the parent workbook, otherwise OnAction will refer to the routine in this workbook
    
    Set btn = destSheet.Buttons.Add(263.4, 97.2, 118.8, 37.8)
    With btn
        .OnAction = "'" & destSheet.Parent.Name & "'!" & destSheet.CodeName & ".Send_Sheet_To_Authoriser"
        .Caption = "Send this sheet to an Authoriser"
        .Name = buttonName
    End With
    
End Sub

2. Add this code to the DFU sheet module (right-click the DFU tab and click View Code to open its sheet module):

Private Sub Send_Sheet_To_Authoriser()

    MsgBox ThisWorkbook.Name & vbCrLf & vbCrLf & _
           "Do you want to send this sheet (" & ActiveSheet.Name & ") to an authoriser?"
    
End Sub

Again, the Send_Sheet_To_Authoriser routine is just a 'stub' for further code to be added.

Save, close and reopen the workbook and test. If no joy, I'll try and get it to work for you.

 

[The Great SrH]

By using ThisWorkbook.SaveCopyAs to create a new .xlsm file.


SaveCopyAs is VBA code, the user doesn't need to Save As using the Excel UI.



What I wrote above is correct for standard modules, i.e. they are not copied to the new workbook if the new workbook is created using Sheets("Sheet Name").Copy.

I have since discovered that code in the sheet's module IS copied to the new workbook with this method, so in your case there is no need to use SaveCopyAs and your code which uses Sheets("DFU").Copy can be used to create the new workbook.

Therefore see if the following steps work for you (I assume your code is in a standard module):

1. Add this code inside your procedure, immediately after the Application.CutCopyMode = False line:

    'Add button to sheet in new workbook
    
    Add_Authoriser_Button "btnSendSheet", Destwb.Worksheets(1)

2. Add this code to the same module, below your code:

Private Sub Add_Authoriser_Button(buttonName As String, destSheet As Worksheet)

    Dim btn As Button
    
    'Add a button to the specified sheet and assign Send_Sheet_To_Authoriser in the sheet's module as its OnAction macro.  We must
    'specify the name of the parent workbook, otherwise OnAction will refer to the routine in this workbook
    
    Set btn = destSheet.Buttons.Add(263.4, 97.2, 118.8, 37.8)
    With btn
        .OnAction = "'" & destSheet.Parent.Name & "'!" & destSheet.CodeName & ".Send_Sheet_To_Authoriser"
        .Caption = "Send this sheet to an Authoriser"
        .Name = buttonName
    End With
    
End Sub

2. Add this code to the DFU sheet module (right-click the DFU tab and click View Code to open its sheet module):

Private Sub Send_Sheet_To_Authoriser()

    MsgBox ThisWorkbook.Name & vbCrLf & vbCrLf & _
           "Do you want to send this sheet (" & ActiveSheet.Name & ") to an authoriser?"
    
End Sub

Again, the Send_Sheet_To_Authoriser routine is just a 'stub' for further code to be added.

Save, close and reopen the workbook and test. If no joy, I'll try and get it to work for you.

Sorry I didnt get back to you sooner John.

Thanks so much for the above - it works perfectly apart from on my extracted sheet. I get the below error:

"We can't update some of the links in your workbook right now.


YOu can continue without updating their values, or edit the links you think are wrong".



When I edit the links, they reference my original workbook.


Any idea how to stop this?



Thanks

 

[John_w]

I took your code and added my code as described and everything works correctly. To fix the error, I need to know more about your workbook setup.

1. Is the Mail_DFU macro in another workbook, or in the same workbook as the hidden DFU sheet?

2. Are there any form buttons or shapes on the DFU sheet which are assigned to macros?

 

[The Great SrH]

I took your code and added my code as described and everything works correctly. To fix the error, I need to know more about your workbook setup.

1. Is the Mail_DFU macro in another workbook, or in the same workbook as the hidden DFU sheet?

2. Are there any form buttons or shapes on the DFU sheet which are assigned to macros?

Sorry for the delay again - I don't check here when not at work!

My spreadsheet is a little more built up than I've described, which may be the issue

1. Mail_DFU is within the same workbook as the hidden DFU sheet


2. There's no extra buttons or shapes, but I do have some extra code within the DFU sheet. I have included that at the end of this post. I'll try summarise what my sheet does first.
- In the original workbook I have a button which will do a number of checks, and then use the "Mail_DFU". Part of this function is to extract the DFU tab, add 2 buttons and then send on to the destination I put in the code
- The next user will then receive the extracted DFU sheet with the newly added buttons. The buttons will then use the code I attached below. One function is to save the file as PDF, and the other is another "Mail" function like the "Mail_DFU".



Hope that explains a bit more!

Private Sub Send_Sheet_To_Authoriser()
If MsgBox("Please Note - This will send all information to a chosen Authoriser" & vbNewLine & vbNewLine & "Do you want to continue?", vbOKCancel, "Send TW Form") = vbOK Then
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sourcewb = ActiveWorkbook
    'Copy the ActiveSheet to a new workbook
    Sheets("DFU").Copy
    Set Destwb = ActiveWorkbook
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With
    '    'Change all cells in the worksheet to values if you want
    With Destwb.Sheets(1).UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
            .Cells(1).Select
        End With
        Application.CutCopyMode = False

    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "DFU via TW Form - " & Format(Now, "dd-mmm-yy h-mm-ss")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            '.To = ""
            .CC = ""
            .BCC = ""
            .Subject = "DFU via TW Form"
            .body = "Hi there"
            .Attachments.Add Destwb.FullName
            .Display   'or use .Send
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End If
End Sub
 
Private Sub Save_Sheet_Authoriser()
If MsgBox("Please Note - This will save the sheet as a PDF document" & vbNewLine & vbNewLine & "Do you want to continue?", vbOKCancel, "Save Refund Request Form") = vbOK Then
    Dim wSheet As Worksheet
    Dim vFile As Variant
    Dim sFile As String
    Set wSheet = ActiveSheet
    sFile = Replace(Replace(wSheet.Name, " ", ""), ".", "_") _
            & "_" _
            & Format(Now(), "yyyymmdd\_hhmm") _
            & ".pdf"
    sFile = ThisWorkbook.Path & "\" & sFile
    vFile = Application.GetSaveAsFilename _
    (InitialFileName:=sFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")
    If vFile <> "False" Then
    wSheet.Range("A1:I22").ExportAsFixedFormat _
        Type:=xlTypePDF, _
        FileName:=vFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
End If
    MsgBox "PDF file has been created."
 End If
End Sub

 

[John_w]

- In the original workbook I have a button which will do a number of checks, and then use the "Mail_DFU". Part of this function is to extract the DFU tab, add 2 buttons and then send on to the destination I put in the code
- The next user will then receive the extracted DFU sheet with the newly added buttons. The buttons will then use the code I attached below. One function is to save the file as PDF, and the other is another "Mail" function like the "Mail_DFU".

If my understanding of your process is correct, the crucial bit is how the code adds the 2 buttons to the extracted DFU sheet, in particular what it assigns to each button's OnAction property. OnAction tells the button which routine to call when the button is clicked.

As my comment in the Add_Authoriser_Button routine in post no. 6 says, in this case the OnAction must specify the workbook name surrounded by single quotes, the sheet's code name and the routine name itself, like this:

        .OnAction = "'" & destSheet.Parent.Name & "'!" & destSheet.CodeName & ".Send_Sheet_To_Authoriser"

so if the workbook is saved as "DFU via TW form - xxxx" and the DFU sheet has the code name "Sheet1" then the OnAction string is:

"'DFU via TW form - xxxx'!Sheet1.Send_Sheet_To_Authoriser"

Otherwise, if the OnAction string is just the routine name, "Send_Sheet_To_Authoriser", then the OnAction will refer to the original workbook, not the workbook which contains the extracted DFU sheet. I hope that makes sense!

Here is the complete code for the original workbook that works for me.

Note that Mail_DFU adds 2 form buttons to the extracted DFU sheet, by making 2 calls to a modified Add_Authoriser_Button routine which allows you to specify the cell where the button should be placed, the button's caption and name:

    Add_Authoriser_Button Destwb.Worksheets(1).Range("C10"), "btnSendSheet", "Send this sheet to an Authoriser", "Send_Sheet_To_Authoriser"     'Email the sheet
    Add_Authoriser_Button Destwb.Worksheets(1).Range("F10"), "btnSaveSheet", "Save this sheet as a PDF document", "Save_Sheet_Authoriser"       'Save the sheet

Standard module:

Sub Mail_DFU()
    
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sourcewb = ActiveWorkbook
    'Copy the ActiveSheet to a new workbook
    Sheets("DFU").Visible = True
    Sheets("DFU").Copy
    Set Destwb = ActiveWorkbook
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With
    'Change all cells in the worksheet to values if you want
    With Destwb.Sheets(1).UsedRange
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
    End With
    Application.CutCopyMode = False
    
    'Add two buttons to DFU sheet in new workbook
    
    Add_Authoriser_Button Destwb.Worksheets(1).Range("C10"), "btnSendSheet", "Send this sheet to an Authoriser", "Send_Sheet_To_Authoriser"     'Email the sheet
    Add_Authoriser_Button Destwb.Worksheets(1).Range("F10"), "btnSaveSheet", "Save this sheet as a PDF document", "Save_Sheet_Authoriser"       'Save the sheet
    
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "DFU via TW Form - " & Format(Now, "dd-mmm-yy h-mm-ss")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With Destwb
        Debug.Print TempFilePath & TempFileName & FileExtStr
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "myemail@email.co.uk"
            .CC = ""
            .BCC = ""
            .Subject = "DFU via TW Form"
            .body = "Hi there"
            .Attachments.Add Destwb.FullName
            '.Send   'or Display
            .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have sent
    Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Sheets("DFU").Visible = False
    
End Sub


Private Sub Add_Authoriser_Button(destCell As Range, buttonName As String, buttonCaption As String, OnActionRoutine As String)

    Dim btn As Button
    
    'Add a button at the specified cell and assign a routine in the parent sheet's module as its OnAction macro.  We must
    'specify the name of the parent workbook (in single quotes), otherwise OnAction will refer to the routine in this workbook
    
    '                                    Add(Left As Double, Top As Double, Width As Double, Height As Double)
    Set btn = destCell.Worksheet.Buttons.Add(destCell.Left, destCell.Top, 120#, 40#)
    With btn
        .OnAction = "'" & destCell.Worksheet.Parent.Name & "'!" & destCell.Worksheet.CodeName & "." & OnActionRoutine
        '.OnAction = destCell.Worksheet.CodeName & "." & OnActionRoutine
        destCell.Offset(4).Value = .OnAction
        .Caption = buttonCaption
        .Name = buttonName
    End With
    
End Sub

DFU sheet module:

This contains the 2 routines to be run by the 2 buttons on the extracted DFU sheet, Send_Sheet_To_Authoriser and Save_Sheet_Authoriser, from your last post. Note that I've added some lines in Send_Sheet_To_Authoriser to delete the 2 buttons on the extracted DFU sheet, because I'm guessing that you don't need them on the DFU sheet that is sent to the Authoriser. Simply delete those lines if I'm wrong.

Private Sub Send_Sheet_To_Authoriser()

    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    If MsgBox("Please Note - This will send all information to a chosen Authoriser" & vbNewLine & vbNewLine & "Do you want to continue?", vbOKCancel, "Send TW Form") = vbCancel Then
        Exit Sub
    End If
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sourcewb = ActiveWorkbook
    'Copy the ActiveSheet to a new workbook
    Sheets("DFU").Copy
    Set Destwb = ActiveWorkbook
    
    'Delete all buttons on the DFU sheet in the new workbook
    Dim btn As Button
    For Each btn In Destwb.Worksheets(1).Buttons
        btn.Delete
    Next
    
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With
    '    'Change all cells in the worksheet to values if you want
    With Destwb.Sheets(1).UsedRange
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
    End With
    Application.CutCopyMode = False

    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "DFU via TW Form - " & Format(Now, "dd-mmm-yy h-mm-ss")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            '.To = ""
            .CC = ""
            .BCC = ""
            .Subject = "DFU via TW Form"
            .body = "Hi there"
            .Attachments.Add Destwb.FullName
            .Display   'or use .Send
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
    'Delete the file you have sent
    Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub
 
 
Private Sub Save_Sheet_Authoriser()

    Dim wSheet As Worksheet
    Dim vFile As Variant
    Dim sFile As String

    If MsgBox("Please Note - This will save the sheet as a PDF document" & vbNewLine & vbNewLine & "Do you want to continue?", vbOKCancel, "Save Refund Request Form") = vbCancel Then
        Exit Sub
    End If
    
    Set wSheet = ActiveSheet
    sFile = Replace(Replace(wSheet.Name, " ", ""), ".", "_") _
            & "_" _
            & Format(Now(), "yyyymmdd\_hhmm") _
            & ".pdf"
    sFile = ThisWorkbook.Path & "\" & sFile
    vFile = Application.GetSaveAsFilename _
                (InitialFileName:=sFile, _
                    FileFilter:="PDF Files (*.pdf), *.pdf", _
                    Title:="Select Folder and FileName to save")
    If vFile <> "False" Then
        wSheet.Range("A1:I22").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=vFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
    End If
    MsgBox "PDF file has been created."
    
End Sub