Hey Leuten. Ein Problem gelöst. Ein Problem bleibt.
Wenn ich nun die Email rausschicke und die ausgewählten Tabellenblätter in eine neue Datei zusammengefasst werden. Dann sind in den neuen Dateien die Farben anders, bzw. bei Seitenlayout -> Farbe möchte/brauch ich office 2007-2010 anstatt office.
Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim lngSheet As Long Dim lngTMP As Long Dim varArrSheets() As Variant On Error GoTo Fin If ListBox1.ListCount = 0 Then MsgBox "Es wurden keine Tabellenblätter gewählt.", vbOKOnly + vbExclamation, "Warnung" Exit Sub Else For lngTMP = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(lngTMP) Then ReDim Preserve varArrSheets(lngSheet) varArrSheets(lngSheet) = ListBox1.List(lngTMP) lngSheet = lngSheet + 1 End If Next lngTMP End If
With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False End With
'Determine the Excel version and file extension/format With Destwb
If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007-2016 Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End With
'Save the new workbook/Mail it/Delete it ' Pfad anpassen - abschliessenden Backslash nicht vergessen!!!
Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0)
With Destwb .SaveAs "S:XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = "" .CC = "" .BCC = "" .Subject = "Test" .Body = "Hallo anbei die Tabelle" .Attachments.Add Destwb.FullName
'Anhang hinzufügen '.Attachments.Add ("U:\Test für Senden.xlsx") '.Send or use .Display End With On Error GoTo 0 .Close savechanges:=False End With
'Delete the file you have send
'Kill TempFilePath & TempFileName & FileExtStr Fin: Set OutMail = Nothing Set OutApp = Nothing
With Application .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True End With
Unload UserForm1
End Sub
Wie du siehst habe ich nach
Code:
ThisWorkbook.Worksheets(varArrSheets).Copy
Set Destwb = ActiveWorkbook
gesagt er soll die Farben auf das Workbook laden, welche ich nutzen möchte. Allerdings wenn ich dies aktiviert habe, öffnet sich outlook nicht mehr und er erstellt mir nur eine Datei.
eventuell schauen wir erst mal, warum die Farben nicht kommen. Daher auch mein Hinweis mit dem exportieren. Hast Du auf dem Zielrechner mal geschaut, ob es das Verzeichnis und das Theme gibt? Ansonsten kannst Du es ja nicht importieren.
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:1 Nutzer sagt Danke an schauan für diesen Beitrag 28 • elamigo
Sorry war in der Winterpause :D erstmal frohes neues Jahr!
Ja das Thema ist bei mir vorhanden. Ich habe es auch in Einzelschritten gemacht, allerdings geht es dann manchmal und manchmal nicht das ist wirklich sehr komisch! ich ändere aber nichts.