Tabellenblatt einmal als pdf und einmal xls datei
29.09.2013 18:55:06
Paddey
ich hab da ein kleineres Problem.
Erschlagt mich bitte nicht gleich wenn es jetzt nicht das schönste Makro ist was ihr bis jetzt gesehen habt, ist das erste Mal das ich mich mit dem Thema Makros auseinander gesetzt habe.
Das was ich da bis jetzt zusammen geschrieben habe, ist alles mit Suchen im Internet entstanden, doch nun komme ich nicht weiter.
Und zwar habe ich eine Tabelle mit 8 Mappen, wobei in den erste 5 Tabellenblätter Infos gesammelt werden und auf einer versteckten Mappe (7. Checkliste) zusammengetragen werden.
Nachdem alles ausgefüllt wurde soll dann der Anwender in der 6 Mappe(6. Speichern)
einen Button drücken und danach soll die versteckte Mappe (7. Checkliste) einmal per Pdf und einmal als .xls Datei (aber nur mit Werten, ohne Formeln) an eine E-Mail Adresse geschickt werden.
Und die Dateien sollen beide denselben Namen haben (siehe Formel).
Ich hoffe ihr könnt mir mit meinem Problem weiterhelfen.
Code:
Sub Schaltfläche3_Klicken()
' Schaltfläche3_Klicken Makro
Sheets("7. Checkliste").Visible = True
Sheets("7. Checkliste").Select
ActiveSheet.AutoFilter.ApplyFilter
Sheets("6. Speichern").Select
Dim app As Object
Dim file As String
Dim isNew As Boolean
Sheets("7. Checkliste").Select
file = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & " " & Worksheets("2. Auswahl"). _
Range("C4").Value & " " & Worksheets("2. Auswahl").Range("C6").Value & ".pdf"
ActiveSheet.ExportAsFixedFormat xlTypePDF, Environ("TEMP") & "\" & file
On Error Resume Next
Set app = GetObject(, "Outlook.Application")
If app Is Nothing Then
Set app = CreateObject("Outlook.Application")
isNew = True
End If
With app.CreateItem(0)
.To = "verbrauchsmaterial.it@test.de"
.CC = ""
.BCC = ""
.Subject = "Preinstallationsliste"
.Body = "Sehr geehrte Damen und Herren." & vbCr _
& vbCr _
& "Anbei die bearbeitete Preinstallationsliste." & vbCr _
& vbCr _
& "Mit freundlichen Grüßen."
.Attachments.Add Environ("TEMP") & "\" & file
.Send
End With
If isNew Then app.Quit
Dim WB As Workbook
For Each WB In Application.Workbooks
WB.Saved = True
Next
Application.Quit
End Sub
Es klappt eigentlich alle soweit bis auf der XLS Part.
Danke schonmal im Voraus
MfG
Paddey