1.1k Aufrufe
Gefragt in Tabellenkalkulation von
Hey :)

Habe Folgendes Problem. Erstmal den makro Ausschnitt da kann ichs
besser erklären.


sBodyFooter = ThisWorkbook.Sheets("Daten").Range("AE44").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE45").Value & vbCrLf & vbCrLf & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE48").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE49").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE50").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE51").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AF52").Value & " " & _
ThisWorkbook.Sheets("Daten").Range("AE52").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE53").Value & _
ThisWorkbook.Sheets("Daten").Range("AE54").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE55").Value & vbCrLf & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE57").Value & vbCrLf & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE59").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE60").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE61").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE62").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE63").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE64").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE65").Value & vbCrLf & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE67").Value







Ich Erstelle mit meiner Makro eine Email per Maus klick und davor einige Einstellungen in der Excel.

Nun geht es darum das ich eine Signatur anfügen müsste Automatisch.
Dabei müssten jedoch alle oben Angezeigten in der Schriftgröße 8 sein. Jedoch alle bis auf AE 57 und AE 67 in der Schriftfarbe Grau, AE 57 in Schriftgröße 8 Magenta und AE 67 in Schriftgröße 8 Grau und Fett. Ist dies möglich? Wenn ja wie?könnte mir jemand Helfen? :) Wäre Lieb


Mit freundlichen Grüßen
Sandy

2 Antworten

0 Punkte
Beantwortet von saarbauer Profi (15.6k Punkte)
Hallo,

dein oben gesandtes Teil eines Makros zeigt nur das die Zellen AE44 bis AE67 miteinander verknüpft werden und es dazwischen Zeilenwechsel gibt. Mehr ist nicht zu erkennen, daher wird es wohl keine richtige Hilfe geben.

Gruß

Helmut
0 Punkte
Beantwortet von
Hey, Dies sind die Betreffenden Zellen welche ich verändern möchte in der E-Mail.

Hier der Ganze Code:

Private Sub CommandButton15_Click()
Dim MyMessage As Object, MyOutApp As Object
Dim Qe As Integer
Dim AWS As String
Dim sEmpfaenger As String, sBetreff As String, sBodyFooter As String, sBodyHeader As String

'Testen ob die aktuelle Mappe schon gespeichert wurde
If ThisWorkbook.Saved = False Then
'Die letzten Änderungen wurden noch nicht gespeichert
Qe = MsgBox("Diese Mappe wurde noch nicht gespeichert, und kann nicht versandt werden!" _
& Chr$(13) & "Soll die Datei gespeichert werden?", vbInformation + vbYesNo, "Sendefehler") _

If Qe = vbNo Then
'Abbruch durch Benutzer
MsgBox "Sendevorgang abgebrochen"
Exit Sub
Else
'Prüfen ob die Datei schon mal gespeichert wurde
If Right(ThisWorkbook.Name, 3) <> "xls" Then
'Nein > Speicherdialog aufrufen
Application.Dialogs(xlDialogSaveAs).Show
Else
'Speichern
ThisWorkbook.Save
End If
End If
End If
'Aktive Arbeitsmappe wird als mail gesendet
'Übergabe des Mappennames an die Variable

AWS = ThisWorkbook.FullName

With ThisWorkbook.Sheets("Daten")

sEmpfaenger = _
.Range("Y2").Value & ";" & _
.Range("Y3").Value & ";" & _
.Range("Y4").Value
sBetreff = _
.Range("Y8").Value
sBodyFooter = _
.Range("Y28").Value & vbCrLf & _
.Range("Y29").Value & vbCrLf & vbCrLf & vbCrLf & _
.Range("Y32").Value & vbCrLf & _
.Range("Y33").Value & vbCrLf & _
.Range("Y34").Value & vbCrLf & _
.Range("Y35").Value & vbCrLf & _
.Range("X36").Value & " " & _
.Range("Y36").Value & vbCrLf & _
.Range("Y37").Value & _
.Range("Y38").Value & vbCrLf & _
.Range("Y39").Value & vbCrLf & vbCrLf & _
.Range("Y41").Value & vbCrLf & vbCrLf & _
.Range("Y43").Value & vbCrLf & _
.Range("Y44").Value & vbCrLf & _
.Range("Y45").Value & vbCrLf & _
.Range("Y46").Value & vbCrLf & _
.Range("Y47").Value & vbCrLf & _
.Range("Y48").Value & vbCrLf & _
.Range("Y49").Value & vbCrLf & vbCrLf & _
.Range("Y51").Value
sBodyHeader = _
.Range("Y16").Value & vbCrLf & _
.Range("Y11").Value & " " & _
.Range("Y22").Value & " " & _
.Range("Y21").Value & vbCrLf & _
.Range("Y12").Value & vbCrLf & _
.Range("Y13").Value & vbCrLf & _
.Range("Y14").Value & vbCrLf & vbCrLf & vbCrLf & vbCrLf







End With
'Outlook Object erstellen
Set MyOutApp = CreateObject("Outlook.Application")
'Outlook Nachricht erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
'Empfänger
.To = sEmpfaenger
'Betreff
.Subject = sBetreff
'Anhang
.Attachments.Add AWS
'Hier wird ein normaler Text erstellt
.Body = sBodyHeader & sBodyFooter

'Hier wird eine HTML Mail erstellt
'Dies kann zu Problemen führen, wenn der Empfänger
'nur TEXT Dateien empfangen darf.
'.HTMLBody = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt und gesendet
'.Send
End With

'Variablen leeren
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub




Habe wegen dem Aussehen die AE auf Y geändert diese Befinden sich im sBodyFooter
...