Not exporting controls to a new workbook

[Carlee]

Hi,
I use the following code to export a series of sheets from my Master book to
a client package that is emailed out. It works great, except that when the
export occurs, it also exports controls (buttons etc). How can i prevent
this?
--
Carlee

Sub Mail_Sheets_Array()
'Working in 97-2007
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 sh As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the sheets to a new workbook
Sourcewb.Sheets(Array("Daily Report", "T-30 Days", "T-30 Graphs",
"Monthly Graphs", "Year at a Glance")).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
'We exit the sub when your answer is NO in the security dialog
that you only
'see when you copy sheets from a xlsm file with macro's disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
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 If
End With

' 'Change all cells in the worksheets to values if you want
' For Each sh In Destwb.Worksheets
' sh.Select
' With sh.UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False
' Destwb.Worksheets(1).Select
' Next sh

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copreco Client Report Package for" & " " & Format(Now,
"dd-mmm-yyyy")

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
.SendMail "", _
"Daily Report Package"
On Error GoTo 0
.Close SaveChanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[Rick S.]

Once Destwb is created delete the controls and buttons, then send.
I would post some code I have used but I do not have it with me.

 

[Ron de Bruin]

See this page for the code you can add to the macro
http://www.rondebruin.nl/controlsobjectsworksheet.htm

If you need help post back

 

[Carlee]

Thanks Rick. I didn't write this code, so i am not sure what i need to add,
and where. If anyone else could help me out that would be really great.

Thanks in advance,

 

[Carlee]

HI,
I tried inserting these two lines into the code i used, and no luck. Could
I get some more help?

ActiveSheet.DrawingObjects.Visible = True
ActiveSheet.DrawingObjects.Delete

 

[Ron de Bruin]

Try this one

Sub Mail_Sheets_Array_test()
'Working in 97-2007
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 sh As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the sheets to a new workbook
Sourcewb.Sheets(Array("Daily Report", "T-30 Days", "T-30 Graphs", "Monthly Graphs", "Year at a Glance")).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
'We exit the sub when your answer is NO in the security dialog that you only
'see when you copy sheets from a xlsm file with macro's disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
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 If
End With

'Change all cells in the worksheets to values and delete shapes
For Each sh In Destwb.Worksheets
sh.Select
On Error Resume Next
sh.DrawingObjects.Visible = True
sh.DrawingObjects.Delete
On Error GoTo 0

With sh.UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False
Next sh
Destwb.Worksheets(1).Select

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copreco Client Report Package for" & " " & Format(Now, "dd-mmm-yyyy")

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
.SendMail "", _
"Daily Report Package"
On Error GoTo 0
.Close SaveChanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[Carlee]

Hi,
So, the code you provided worked, however, I didn't realize that a chart was
an object...which of course now that i think about it, of course it is!
So....is there a way to delete every other control, except the charts i have
on two pages?

Sorry to be a pain.

 

[Carlee]

Working with the code i provided, is there a way to add a line that when the
exported book is opened by the receiving party, that the 'Update Links' popup
message is NOT displayed?

 

[Ron de Bruin]

Hi Carlee

See the code in the link I posted or check the sheet name in the loop
and if it is one of the two sheets do nothing

Good night

 

[Ron de Bruin]

If you have links see
http://www.rondebruin.nl/values.htm