|
Servus zusammen
Schon mal Vorab vielen Dank für Eure Hilfe, leider bin ich ein blutiger Anfänger was VBA betrifft, habe mir aber mit diversen Foren und "google" einen Code zusammengebastelt der soweit ganz gut funktioniert. Nun möchte ich den noch erweitern und stehe an.
Ausgangslage: Alle 3 Monate möchte ich eine Lieferantenbewertung an den Lieferanten senden. Diesbezüglich habe ich diverse Pivots erstellt wo ich mittels Datenschnitt einen Lieferanten wählen kann und entsprechenden Daten und Grafiken aufbereitet werden.
Mittlerweilen umfasst der Stamm über 100 Liefernaten und entsprechend 100 mal klicken & versenden wird zu aufwändig.
Was habe ich bisher geschafft:
Die Pivot selektionierung geht automatisch auf das Feld "A58" im Tab Report
Als zweites erstellt er aus dem zu Bedruckenden Bereich ein PDF und fügt das PDF in eine Email ein, welche ich dann noch mittels Senden Button im Outlook versenden kann.
Die Erweiterung:
Im Feld A59 / A60 etc stehen nun die nächsten Lieferanten welchen den Report auch erhalten sollen. Nun möchte ich den Ablauf als Loop darstellen bis eine Leere Zelle z.B A175 erscheint.
D.H Pivot selektionierung auf A60, PDF Versenden
Pivot selektionierung auf A61, PDF Versenden
etc etc
Hier mal den Code, welche ich soweit erstellt habe.
Zusatzfrage: ist es korrekt das Excel die Email auch im Hintergrund versenden kann ohne das ich den Senden Button drücken müsste?
Thanks againg
Gruss Pascal
Sub Report_an_Pascal_Senden()
Worksheets("Pivots").PivotTables(2).PageFields("bezeichnung").CurrentPage = Worksheets("Report").Range("A58").Text
Dim olApp As Object
Dim olOldBody As String
Dim strPathNamePDF As String
Dim arrSheets
arrSheets = Array("Report") '
For i = LBound(arrSheets) To UBound(arrSheets)
strPathNamePDF = "N:\Abteilungen\Einkauf\02_Kennzahlen\Lieferantenbewertung\2016\Lieferantenbewertung_2016.pdf"
Sheets(arrSheets(i)).ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPathNamePDF, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.GetInspector.Display
olOldBody = .htmlBody
.To = "pascal.deubelbeiss@hapa.ch; roger.bruegger@hapa.ch; tobias.mahrer@hapa.ch; ralf.schoenberger@hapa.ch"
.Subject = "Besuchsreport_" & Format(Now, "mmm,yyyy") & "_" & ThisWorkbook.Worksheets("Report").Range("N71")
.Attachments.Add strPathNamePDF
.htmlBody = "Ciao zäme, anbei ein neuer Besuchsreport" & olOldBody
End With
Set olApp = Nothing
Next i
End Sub
|