Una macro que lo que tenga seleccionado incluyendo gráficas, me lo guarde como archivo con un nombre específico, mande x Outlook

Que una hoja de Excel, seleccionamos un rango y que este rango incluyendo gráficas, lo guarde como un archivo con un nombre determinado, y mande a ciertas personas. Tengo dominado parcialmente el proceso, ya que este proceso funciona bien hasta que me toca seleccionar una gráfica esta no la copia, me podrían dar ideas u una macro que funcione al 100%. La mía la pongo aquí a ver si me falta o sobra algo. Gracias

Sub ArchivoEnvio()

Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object

Set Source = Nothing
On Error Resume Next
Set Source = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Source Is Nothing Then
MsgBox "La fuente no es un rango o la hoja está protegida, por favor, corrige y vuelve a intentarlo.", vbOKOnly
Exit Sub
End If

If ActiveWindow.SelectedSheets.Count > 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count > 1 Then
MsgBox "Ocurrió un error :" & vbNewLine & vbNewLine & _
"Haya más de una hoja seleccionada." & vbNewLine & _
"No selecciono una la celda para enviar.." & vbNewLine & _
"Ha seleccionado más de un área." & vbNewLine & vbNewLine & _
"Por favor, corrija y vuelva a intentarlo.", vbOKOnly
Exit Sub
End If

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

Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)

Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

TempFilePath = Environ$("temp") & "\"
TempFileName = " " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = "*Archivo por Hora " & Hour(Now) & ":" & "00" & "Hrs"
.Body = ""
.Attachments.Add Dest.FullName
.Display
End With
On Error GoTo 0
.Close savechanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

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

End Sub