|
Hallo Karl-Heinz
Wieso geht das mit der Schriftgrösse beim untenstehenden Makro nicht? Wird immer noch klein im E-Mail dargestellt.
Sub Mail_Senden()
'Sendet Mail mit integriertem Bereich als Bild mit Signatur
'Das Bild wird über das Kürzel ~ im Text platziert
Dim WSh As Worksheet, WkS As Worksheet
Dim sMailtext As String, sBild As String, sSignatur As String
Dim sBer As String, iEinf As Integer
sBer = "A20:K33" 'Kopierbereich
Set WSh = ThisWorkbook.Sheets("Transport") 'Blatt mit Maildaten
On Error Resume Next
'Bereich kopieren
Do
WSh.Range(sBer).CopyPicture Appearance:=xlScreen, Format:=xlBitmap
If Err.Number = 0 Then Exit Do
Err.Clear
Loop
With CreateObject("Outlook.Application").CreateItem(0)
.BodyFormat = 2 'HTML-Format, Angabe optional
.Subject = "Crate and Weight Size " & WSh.Range("F20").Value 'Betreff
.To = "test@mail.com" 'Empfänger
sMailtext = "Hi ," & vbLf & vbLf & "Crate and weight size for " _
& WSh.Range("F20").Value & ":" & vbLf & vbLf
.GetInspector: sSignatur = .HTMLBody 'Signatur holen
.HTMLBody = "<span style='font-family:Calibri;font-size:11.5pt;color:black;'>" _
& Replace(sMailtext, vbLf, "<br>") & "</span>" & sSignatur
.Display
iEinf = Len(sMailtext) - 1 'Grafik Einfügestelle
With .GetInspector.WordEditor.Application.Selection
.Start = iEinf: .End = iEinf
.Paste 'Grafik in Mail einfügen
End With
End With
End Sub
Sub Mail_TransportBestellungSenden_mit_PDF()
'Sendet Mail mit integriertem Bereich als Bild mit Signatur
'Das Bild wird über das Kürzel ~ im Text platziert
Dim WSh As Worksheet
Dim sMailtext As String, sSignatur As String
Dim sDateiName As String, T As String
'<<<Tabellenblatt anpassen>>>
Set WSh = ThisWorkbook.Sheets("Transport") 'Blatt mit Maildaten
sDateiName = ThisWorkbook.FullName
sDateiName = Left$(sDateiName, InStrRev(sDateiName, ".")) & "pdf"
T = ThisWorkbook.Path & "\"
sDateiName = Replace(sDateiName, T, T)
'sDateiName = Replace(sDateiName, T, T & WSh.Range("F20").Value & "_")
'<<<Tabellenblatt anpassen>>>
ThisWorkbook.Sheets("Transport").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sDateiName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
With CreateObject("Outlook.Application").CreateItem(0)
.BodyFormat = 2 'HTML-Format, Angabe optional
.Subject = "Transportbestellung " & WSh.Range("F20").Value 'Betreff
.To = Replace(WSh.Range("G8").Value, vbLf, ";") 'Empfänger
sMailtext = "Guten Tag," & vbLf & vbLf & "Im Anhang sende ich Ihnen die Transportbestellung für den Auftrag " _
& WSh.Range("F20").Value & "." & vbLf & vbLf & "Gerne erwarte ich Ihre Bestätigung mit dem genauen Abholtermin."
.GetInspector: sSignatur = .HTMLBody 'Signatur holen
.HTMLBody = "<span style='font-family:Calibri;font-size:11.5pt;color:black;'>" _
& Replace(sMailtext, vbLf, "<br>") & "</span>" & sSignatur
.Display
'Anlage anfügen
If Dir$(sDateiName) <> "" Then
.Attachments.Add sDateiName 'Anlage anfügen
End If
End With
End Sub
Ist da noch ein Fehler drin?
Gruss
ch79
|