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:
Code:
.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:
Code:
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:
Code:
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.
Code:
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
