Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA - Nur Werte statt Formeln und Druckbereich per Mail versenden
#1
Hallo Forum-Gemeinde,

H Ü L F E  :17:

Aus einer Excel-Mappe möchte ich einzelne zuvor definierte Tabellenblätter per E-Mail versenden. Dies habe ich mir so weit zusammengebastelt:

Sub GSV_Protokolle_senden_senden()
Dim strDatei As String
Dim strPfad As String
Dim outObj As Object
Dim Mail As Object
Dim strBodyText As String
Dim arrTabs()
ReDim arrTabs(1 To 3)
    arrTabs(1) = "IB GSV"
    arrTabs(2) = "Einw. GSV"
    arrTabs(3) = "Abn. GSV"
    Worksheets(arrTabs).Copy
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
strPfad = "H:\"
ActiveWorkbook.SaveAs strPfad & "GSV Protokolle" & " # " & ActiveSheet.Range("V3") & ".xls"
strDatei = ActiveWorkbook.FullName
With Mail
'.To = ""
'.CC = ""
.Subject = "" 'Betreff
.BodyFormat = 2 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.Body = strBodyText 'Bodytext / Signatur
End With
Workbooks(Dir(strDatei)).Close
Kill (strDatei)
Mail.Display
End Sub

Was nun noch fehlt: Ich möchte gerne in der Zieldatei nur Werte, keine Formeln stehen haben UND ich würde gerne nur einen ausgewählten Druckbereich in der Zieldatei haben wollen.
Kann mir hier jemand behilflich sein?

Vielen Dank im Voraus.
Antworten Top
#2
Hallöchen,

sollte alles relativ einfach gehen, ggf. mit Aufzeichnen.

Wenn Du die Mappe oder Tabelle gespeichert hast, tust Du einfach alles kopieren und mit Inhalte Einfügen - Werte die Formeln entsprechend ersetzen.

Beim Druckbereich wäre zu überlegen, ob der auch für Dich passt. Dann kannst Du ihn gleich im Original festlegen und er bleibt dann so. Ansonsten auch mal aufzeichnen und das Makro dann aus dem "Sendemakro" heraus aufrufen.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#3
Das bringt mich irgendwie noch nicht weiter...
Hat jemand einen Vorschlag, wie man die Punkte einbinden kann?
Antworten Top
#4
Hallöchen,

hast Du denn schon was aufgezeichnet? Wenn Du das postest, kann ich es Dir einbauen.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#5
Dies wäre im Prinzip die Aufzeichnung... hier wurde statt der Auswahl des Druckbereiches die überflüssigen Spalten gelöscht.


Code:
Columns("T:W").Select    
Selection.Delete Shift:=xlToLeft
   Sheets("Abn. GSV").Select
   Columns("T:Z").Select
   Selection.Delete Shift:=xlToLeft
   Sheets("Einw. GSV").Select
   Columns("T:Z").Select
   Selection.Delete Shift:=xlToLeft
   Sheets("IB GSV").Select
   Cells.Select
   Selection.Copy
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("Abn. GSV").Select
   Cells.Select
   Application.CutCopyMode = False
   Selection.Copy
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("Einw. GSV").Select
   Cells.Select
   Application.CutCopyMode = False
   Selection.Copy
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False

Kann man diese Zeile aus dem oben genannten Code erweitern, dass nur ein festgelegter Bereich kopiert wird (.Range, o.ä)?

Code:
Worksheets(arrTabs).Copy
Antworten Top
#6
Hallöchen,

Zitat:Kann man diese Zeile aus dem oben genannten Code erweitern, dass nur ein festgelegter Bereich kopiert wird (.Range, o.ä)?
Ich hatte ja gedacht, dass Du das auch beim Ersetzen der Formeln so machst. Nun hast Du aber alle Zellen kopiert und eingefügt ...

Im konkreten Fall
Worksheets(arrTabs).Copy
geht es aber darum, dass die Blätter in eine neue Datei kopiert werden.
Wenn Du nur Bereiche kopieren willst, müsstest Du die Blätter und die Datei, wo die Daten hin sollen, vorher anlegen.
im Prinzip

WorkBooks.Add
ActiveWorkBook.SaveAs "LW:\Pfad\" & "neueMappe.xls"
Sheets.Add
ActiveSheet.Name = "neuesBlatt"
Range("A1:B2").Value = Workbooks("alteMappe").Sheets("altesBlatt").Range("A1:B2").Value

Oder
Du kopierst die Blätter und, wie in Deinem aufgezeichneten Code, löschst Du anschließend nicht benötigte Daten / Spalten / Zeilen / Zellen ...

In Deinem aufgezeichneten Code hast Du einige Spalten gelöscht. Das hab ich jetzt mal außen vor gelassen, stand ja noch nicht zur Debatte.
Hier mal auf Basis der Aufzeichnung ein zusammengefasster Code.

Code:
Sub test()
Sheets("IB GSV").Select
Cells.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Abn. GSV").Select
Cells.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Einw. GSV").Select
Cells.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Eingefügt in Deinen Code und noch das Select entfernt sieht das dann so aus:

Sub GSV_Protokolle_senden_senden()
Dim strDatei As String
Dim strPfad As String
Dim outObj As Object
Dim Mail As Object
Dim strBodyText As String
Dim arrTabs()
ReDim arrTabs(1 To 3)
    arrTabs(1) = "IB GSV"
    arrTabs(2) = "Einw. GSV"
    arrTabs(3) = "Abn. GSV"
    Worksheets(arrTabs).Copy
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
strPfad = "H:\"
ActiveWorkbook.SaveAs strPfad & "GSV Protokolle" & " # " & ActiveSheet.Range("V3") & ".xls"
With Sheets("IB GSV")
.Cells.Copy
.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
With Sheets("Abn. GSV")
.Cells.Copy
.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
With Sheets("Einw. GSV")
.Cells.Copy
.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
ActiveWorkbook.Save
strDatei = ActiveWorkbook.FullName
With Mail
'.To = ""
'.CC = ""
.Subject = "" 'Betreff
.BodyFormat = 2 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.Body = strBodyText 'Bodytext / Signatur
End With
Workbooks(Dir(strDatei)).Close
Kill (strDatei)
Mail.Display
End Sub
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#7
Cells = Cells.Value

reicht doch! Nicht immer durch die Gegend kopieren.
Antworten Top
#8
Das hat geholfen. Prima, danke sehr  :19:
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste