Hallo zusammen,
ich erstelle eine Betriebskostenabrechnung über Excel 2013 und bin User kein VBA Mann!
Jetzt habe ich mir hier aus dem Netz die VBA Anwendung
Excel per pdf speichern und per
Mail verschicken kopiert und liebgewonnen.
Wenn mir jemand den Weg zeigen könnte, wie ich meine Checkbox „Drucken“,
um folgende Funktionen erweitern kann:
1. Kontrollkästchen für pdf erstellen für Tabelle 1, Tabelle 2, Tabelle 3 (also für 3 Mieter)
2. Dito für Email senden
3. Die Parameter für die pdf, wie Datei Name, Speicherort und für die Mail, Mailadresse,
Betreff und Mailname, also nicht wie jetzt auf der aktiven Tabelle gespeichert habe und dann mit der Abrechnung dem Mieter sende.
Und das habe ich:
Option Explicit
Private Sub CheckBox1_Click()
End Sub
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'++++++++++++++++++++++++ CONTROLS +++++++++++++++++++++++++++++++
Private Sub chkAlleOhneMieterwechsel_Click()
If Me.chkAlleOhneMieterwechsel = True Then
Me.chkParterre = True
Me.chkOG1 = True
Me.chkOG2 = True
Me.chkDachgeschoss = True
Me.chkMieterwechsel = False
Me.chkLeerstand1 = False
Me.ChkMieterw2OG = False
Me.ChkLeerstand2OG = False
Else
Me.chkParterre = False
Me.chkOG1 = False
Me.chkOG2 = False
Me.chkDachgeschoss = False
Me.chkMieterwechsel = False
Me.chkLeerstand1 = False
Me.ChkMieterw2OG = False
Me.ChkLeerstand2OG = False
End If
End Sub
Private Sub chkLeerstand1_Click()
End Sub
Private Sub ChkLeerstand2OG_Click()
End Sub
Private Sub chkMieterwechsel_Click()
End Sub
Private Sub chkOG2_Click()
End Sub
Private Sub chkParterre_Click()
End Sub
Private Sub chkMieterw2OG_Click()
End Sub
Private Sub cmdDrucken_Click()
Call Drucken
End Sub
Private Sub cmdZurück_Click()
Unload Me
End Sub
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Private Sub Drucken()
Dim lngCnt&, wsh As Worksheet
If Me.chkParterre = True Then
On Error Resume Next
Set wsh = Worksheets("Kalisch")
On Error GoTo 0
If Not wsh Is Nothing Then
wsh.PrintOut
lngCnt = lngCnt + 1
End If
End If
If Me.chkOG1 = True Then
On Error Resume Next
Set wsh = Worksheets("Laubscher 1")
On Error GoTo 0
If Not wsh Is Nothing Then
wsh.PrintOut
lngCnt = lngCnt + 1
End If
End If
If Me.chkOG2 = True Then
On Error Resume Next
Set wsh = Worksheets("Kill 2. OG")
On Error GoTo 0
If Not wsh Is Nothing Then
wsh.PrintOut
lngCnt = lngCnt + 1
End If
End If
If Me.chkDachgeschoss = True Then
On Error Resume Next
Set wsh = Worksheets("Appartement")
On Error GoTo 0
If Not wsh Is Nothing Then
wsh.PrintOut
lngCnt = lngCnt + 1
End If
End If
If Me.chkMieterwechsel = True Then
On Error Resume Next
Set wsh = Worksheets("Mieterw.")
On Error GoTo 0
If Not wsh Is Nothing Then
wsh.PrintOut
lngCnt = lngCnt + 1
End If
End If
If Me.chkLeerstand1 = True Then
On Error Resume Next
Set wsh = Worksheets("Leerstand1")
On Error GoTo 0
If Not wsh Is Nothing Then
wsh.PrintOut
lngCnt = lngCnt + 1
End If
End If
If Me.ChkMieterw2OG = True Then
On Error Resume Next
Set wsh = Worksheets("Mieterw2OG")
On Error GoTo 0
If Not wsh Is Nothing Then
wsh.PrintOut
lngCnt = lngCnt + 1
End If
End If
If Me.ChkLeerstand2OG = True Then
On Error Resume Next
Set wsh = Worksheets("Leerstand2OG")
On Error GoTo 0
If Not wsh Is Nothing Then
wsh.PrintOut
lngCnt = lngCnt + 1
End If
End If
Unload Me
MsgBox "Es wurden '" & lngCnt & "' Druckaufträge versendet!", vbInformation, _
"Druckaufträge"
End Sub
Private Sub UserForm_Click()
End Sub
Sub pdf_erstellen()
Dim sBlatt As String
Dim sPdfDateiF5 As String
Dim sPdfDateiA13 As String
Dim OutApp As Object
Dim OutMail As Object
' auf welches Tabellenblatt greifen wir später zu, um E-Mail, Betreff und Inhalt auszulesen?
sBlatt = "Kalisch"
' unter welchem Namen sollen die PDF-Dateien abgespeichert werden?
sPdfDateiC108 = "C:\2015\" & Cells(108, "C").Value & ".PDF"
sPdfDateiC105 = "C:\2015\" & Cells(105, "C").Value & ".PDF"
' "C:\Users\Günter Kalisch\2015\BetriebskostenabrTest192.xlsm", FileFormat:=
' xlOpenXMLWorkbookMacroEnabled , CreateBackup:=False
' speichert das aktuelle Blatt (=ActiveSheet) als PDF
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sPdfDateiC108, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' speichert die aktuelle Excelmappe (=ActiveWorkbook) als PDF
ActiveWorkbook.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sPdfDateiC105, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' Bezug zu Outlook herstellen...
Set OutApp = CreateObject("Outlook.Application")
' ...damit wir eine neue
E-Mail erzeugen können
Set OutMail = OutApp.CreateItem(0)
' Werte den Eigenschaften zuweisen...
OutMail.To = Sheets(sBlatt).Range("A10").Value
OutMail.CC = ""
OutMail.BCC = ""
OutMail.Subject = Sheets(sBlatt).Range("C112").Value
OutMail.Body = Sheets(sBlatt).Range("C114").Value
' Anhang hinzufügen: ja welchen denn? Dann also beide Dateien???
OutMail.Attachments.Add sPdfDateiC108
'OutMail.Attachments.Add sPdfDateiC105
' ...und abschicken
OutMail.Send
' Objekte sauber auflösen
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Wenn mir jemand helfen könnte würde ich mich sehr