Pivot aktualisieren und via Mail senden
21.05.2008 18:51:00
Dustbin2001
ich versuche mich mal wieder mehr oder weniger erfolgreich an VBA.
Folgender Hintergrund:
Ich habe eine Excel-Tabelle mit zwei Tabellenblättern, wobei ein Tabellenblatt die Datenquelle ist und das andere Tabellenblatt eine Pivot-Tabelle dieser Datenquelle. Nun habe ich zwei Steuerbuttons auf dem Datenquellenblatt eingefügt. Der eine Button soll die Pivot Tabelle aktualisieren, der andere soll dann die Pivot Tabelle kopieren, in eine neue Worksheet einfügen, in einem bestimmten Ordner speichern und diese als E-Mail Anhang an eine Person via Mail versenden.
So weit so gut - und beide Makros funktionieren auch mehr oder weniger. Allerdings bin ich noch nicht ganz zufrieden und hätte gerne noch ein paar weitere Features.
Steuerbutton "Pivot aktualisieren":
Die Pivot Tabelle soll nach dem aktualisieren mit einem Passwort schreibegschützt werden, da die Person die diese bekommt zwar die Summen sehen darf, aber nicht wie sich diese zusammensetzen (was ja über einen Doppelklick in der Pivot Tabelle möglich wäre).
Steuerbutton "Pivot senden":
Die Datei (also die Pivot Tabelle in einer neuen Excel Datei) soll in einem ganz bestimmten Ordner gespeichert werden mit einem bestimmten Dateinamen. Der Dateiname befindet sich dabei in Zelle A1.
Bevor das ganze jedoch per Mail verschickt wird, hätte ich gerne noch eine Kontrollfrage, so in die Richtung "Wollen Sie wirklich die Datei versenden" - JA - NEIN. Allerdings habe ich keine Ahnung wie man das einbauen kann.
Ich hoffe ich konnte meine Problematik deutlich machen und hoffe auf Vorschläge!
Hier die Makros: Pivot senden:
Sub MailSenden()
Application.ScreenUpdating = False
On Error Resume Next
Dim empfänger As String
Dim i As Integer
Dim aws As String
Dim olapp As Object
For i = 1 To 1
Sheets(i).Activate
empfänger = Sheets(i).Range("D1").Value
ActiveWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs ActiveSheet.Name
aws = ActiveWorkbook.FullName
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
Set Rng = Selection
.To = empfänger
'.CC = "" 'Optional Kopie an
'.BCC = "" 'Optional Blindkopie an
.Subject = Range("A1")
.HtmlBody = "
Hallo,
dies ist ein Test.
.attachments.Add aws
.Display
SendKeys "%s", True 'Mail sofort senden
ActiveWorkbook.Close
Set olapp = Nothing
End With
Next i
Sheets(1).Activate
Application.ScreenUpdating = True
End Sub
Pivot aktualisieren:
Sub PivotAktualisieren()
' PivotAktualisieren Makro
Sheets("Pivot Test").Select
Range("B20").Select
ActiveSheet.Unprotect
Range("B14").Select
ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True
Sheets("test").Select
End Sub