Hallo M.O
ich Check es einfach nicht :-(
In meiner Excel ist der Button der eine Email sendet.
Ich hab Kontrollkästchen 81 und 82.
Wenn die nicht angewählt werden soll er sagen bitte anwählen.
Könntest du so nett sein, den Code hier einbauen ?
Vielen dank für deine Unterstützung, aber ich komme seit Tagen hier nicht weiter.
Sub e_Mail()
'** Dimensionierung der Variablen
Dim strPDF As String
Dim OutlookApp As Object, strEmail As Object
'** Vorgaben definieren
Set OutlookApp = CreateObject("Outlook.Application")
Set strEmail = OutlookApp.CreateItem(0)
'** PDF erzeugen
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\Excel-File.pdf", Quality:=xlQualityStandard _
, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _
:=False
'**Sub Pruefung()
Dim rngZelle As Range
Dim rngBereich As Range
Dim strZelle As String
Set rngBereich = Union(Range("F5"), Range("M5"), Range("F15"), Range("J15"), Range("M15"), Range("P15"), Range("R15"), Range("L18"), Range("L19"), Range("F25"), Range("J25"), Range("N25"), Range("P25")) '<== hier alle Prüfzellen einbinden
For Each rngZelle In rngBereich
If rngZelle = "" Then strZelle = strZelle & vbLf & rngZelle.Address
Next rngZelle
If strZelle <> "" Then
MsgBox "Bitte alle Pflichtfelder ausfüllen, ansonsten kann ihr Antrag nicht bearbeitet werden:", vbAbortRetry
Exit Sub
End If
'** E-Mail versenden
strPDF = ThisWorkbook.Path & "\Excel-File.pdf"
With strEmail
.To = "****@web.de"
.Subject = Worksheets("Tabelle1").Range("F25").Value & " " & Range("G134").Value & " " & Range("N25").Value & " " & Range("H134").Value & " " & Range("P25").Value & " " & Range("G134").Value & " " & Range("M5").Value & " " & Range("A134").Value & " " & Range("F15").Value & " " & Range("D134").Value & " " & Range("F41").Value
.Body = "In Anlage befindet sich ein Antrag auf Fremdfirmenausweis."
.Attachments.Add strPDF
.Display
'.Send 'Damit wir die E-Mail sofort versendet
Kill strPDF
End With
'** Objektvariablen wieder löschen
Set OutlookApp = Nothing
Set strEmail = Nothing
End Sub