Mailen van een xls sheet (VBA)

[Moby123888]

Goedemorgen,

Ik heb enige tijd geleden deze VBA op deze site gevonden en werkt geweldig.
Nu wilde ik dit voor een sheet met formules ook gebruiken, maar merk dan dat hij de formules meeneemt in het nieuw gemaakte bestand, waardoor de ontvanger een tal van verwijzingen krijgt.
Ik zou graag willen dat hij de hele opmaak en waardes in een nieuw bestand zet, maar heb wat moeite om deze VBA te ontleden.
Weet iemand hoe ik dit kan veranderen?

Sub Mail_ActiveSheet()

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

ActiveSheet.Copy
Set Destwb = ActiveWorkbook

With Destwb
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
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 With

TempFilePath = Environ$("del") & ""
TempFileName = "overzicht " & "(locatie..) "

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 = "ed@info.com"
.CC = ""
.BCC = ""
.Subject = "Overzicht"
.Body = "Goedendag, bijgaand .......!"
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.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
End Sub

 

[edmoor]

Door eerst deze Sub uit te voeren worden alle formules in het hele werkboek vervangen door hun waarde,

Sub FormulesNaarWaarden()
    For Each sh In ThisWorkbook.Sheets
        For Each cl In sh.UsedRange
            cl.Value = cl.Value
        Next cl
    Next sh
End Sub

Dit is niet terug te draaien.
Sla daarna dus het werkboek op met een andere naam en verzend dat werkboek.
Sluit dan het originele werkboek zonder op te slaan, anders ben je de formules kwijt.

P.S:
Wanneer je hier code plaatst, zet deze dan in codetags.

 

[AHulpje]

Je kopieert maar één werkblad, dus als je dit na ActiveSheet.Copy plaatst gaat het goed:

For Each cl In ActiveSheet.UsedRange
    cl.Value = cl.Value
Next cl

 

[HSV]

activesheet.copy
activesheet.usedrange = activesheet.usedrange.value