Vorm Zellen löschen Formeln in Werte
13.02.2021 12:35:00
RaMa
ich habe mir ein Makro zusammengebastelt, um automatisch eine E-Mail samt Excel-Anhang zu erstellen.
In der Excelmappe habe ich 1 Start- sowie 1 Enddatum, das wiederum durch verschiedene Formeln bearbeitet wird.
Wenn durch das Ausführen des Makros die E-Mail samt Anhang geöffnet wird, werden verschieden Buttons, Zeilen und Spalten gelöscht.
Leider wird dadurch ein Bezug gelöscht.
Mein Ziel/Wunsch: Der Bereich "F34:G35" soll in der Ursprungsdatei als Formel beibehalten werden, allerdings im E-Mail-Anhang als Wert angezeigt werden.
Leider wird durch mein Makro die Excel-Datei abgeändert und im E-Mail-Anhang wird ein Bezugsfehler angezeigt.
Mit folgendem Befehl komme ich nicht weiter:
Range("F34:G35").Copy
Range("F34:G35").PasteSpecial xlPasteValues
Anbei mein benutztes Makro:
Private Sub CommandButton3_Click()
Dim xOutApp As Object
Dim xOutMail As Object
Dim strBlatt As String
Dim strDatei As String
Dim strPfad As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
'** Pfad für temporäre Zwischenspeicherung angeben
strPfad = "C:\Temp" 'entsprechend anpassen
'** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
strBlatt = ActiveSheet.Name
'** Gewähltes Tabellenblatt kopieren
Sheets(strBlatt).Copy
Application.DisplayAlerts = False
Range("F34:G35").Copy
Range("F34:G35").PasteSpecial xlPasteValues
ActiveSheet.Shapes.Range(Array("CommandButton1")).Delete
ActiveSheet.Shapes.Range(Array("CommandButton2")).Delete
ActiveSheet.Shapes.Range(Array("CommandButton3")).Delete
ActiveSheet.Shapes.Range(Array("CommandButton4")).Delete
ActiveSheet.Shapes.Range(Array("CommandButton5")).Delete
ActiveSheet.Rows("1:31").Delete
ActiveSheet.Columns("M:AA").Delete
'** Blatt temporär in vorgegebenes Verzeichnis abspeichern
ActiveWorkbook.SaveAs strPfad & "\" & ActiveSheet.Name
Application.DisplayAlerts = True
'** Pfad und Dateiname der neuen Datei zwischenspeichern
strDatei = ActiveWorkbook.FullName
With xOutMail
.GetInspector
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.Attachments.Add strDatei
.HTMLBody = "Hallo zusammen,
anbei sende ich euch die Liste." & .HTMLBody
.Display 'or use .Send
End With
'** Erzeugte Datei schließen
Workbooks(Dir(strDatei)).Close
'** Erzeugte Datei wieder löschen
Kill (strDatei)
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Vielen Dank vorab.
Grüße
Raphael
Anzeige