VBA
17.08.2018 17:21:32
Marquardt
ich habe folgendes Problem.
Nach der Abfrage, ob alle Zellen beschrieben sind, soll einen pdf-Datei erzeugt werden.
Leider funktioniert das nicht immer.
Kann mir jemand helfen?
Wie kann ich die pdf-Datei immer dort Speicher, wo die Excel-Datei gespeichert ist?
Sub test()
Dim chkRange As Range, myC As Range
Dim msg As String
Set chkRange = Sheets("Abnahme").Range("A6,A8,d10,B6,e260")
msg = ""
For Each myC In chkRange
If IsEmpty(myC) Then
msg = msg & myC.Address & vbCrLf
End If
Next
If msg = "" Then
Else
MsgBox "Folgende Zellen sind leer:" & Chr(13) & vbCrLf & msg, vbInformation + vbOKOnly, " _
Ergebnis"
Exit Sub
End If
ChDir ThisWorkbook.Path 'anpassen 'oder thisworkbook.path
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Sheets("Abnahme").Range("T1").Value & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.createItem(0)
With objMail
.GetInspector ' sorgt für die Signatur
.To = Sheets("Abnahme").Range("S3").Value
.CC = Sheets("Abnahme").Range("t4").Value
.BCC = Sheets("Abnahme").Range("t5").Value
.Subject = ThisWorkbook.Worksheets("Abnahme").Range("T1")
.body = Sheets("Abnahme").Range("T2").Value & .body
.Display 'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend _
manuell vom User!
MsgBox ("ACHTUNG!" & Chr(13) & Chr(13) & "Fügen Sie folgende Anlage an:" & Chr(13) & Chr(13) _
& "- die pdf-Datei mit dem Namen" & Chr(13) & Sheets("Abnahme").Range("t1") & Chr(13) & "- die Bilder (1,2,3, usw.)" & Chr(13) & Chr(13) & "Bitte die zu sendende(n) Datei(en) auswählen!"), vbInformation, "Bestandsmanagement der Objektverwaltung Ponholz"
Set fdOpen = Application.FileDialog(msoFileDialogOpen)
With fdOpen
.AllowMultiSelect = True
.InitialView = msoFileDialogViewList
.InitialFileName = ActiveWorkbook.Path
.Title = "Bitte die zu sendende(n) Datei(en) auswählen!"
.ButtonName = "als Anlage zur E-Mail senden"
If .Show = True Then
Dim i As Integer
If .SelectedItems.Count > 0 Then
For i = 1 To .SelectedItems.Count
objMail.attachments.Add .SelectedItems(i)
Next
End If
End If
End With
End With
SendKeys Body
End Sub
Vielen Dank!