Farben von erstellen Tabellen ändern

[elamigo]

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.

[elamigo]

Code:

ActiveWorkbook.Theme.ThemeColorScheme.Load ( _
      "DATEIPFAD des Theme\Theme.xml" _
     )
   

[elamigo]

Scheint wohl doch nicht zu klappen. Schade hat sonst jemand eine Idee?

[schauan]

Hallöchen,

was klappt denn nicht?
Wenn Du was importieren willst, musst Du auch was exportieren und mitgeben.

[elamigo]

Hey schauan,

das ist mein Code für das senden der mail.

Code:

Private Sub CommandButton2_Click()

   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

   Set Sourcewb = ActiveWorkbook

   'Copy the ActiveSheet to a new workbook
   
   'ActiveSheet.Copy
   
   ThisWorkbook.Worksheets(varArrSheets).Copy
   
   Set Destwb = ActiveWorkbook
               
   
   'Destwb.Theme.ThemeColorScheme.Load ( _
    ' "C:\Program Files (x86)\Microsoft Office\Document Themes 16\Theme Colors\Office 2007 - 2010.xml" _
    ')
   
   'ThisWorkbook.Worksheets(Array("Tabelle14", "Diagramm2")).Copy

   '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!!!
   
 
   TempFilePath = Environ$("temp") & "\"
   TempFileName = TextBoxDatei.Text

   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.

[schauan]

Hallöchen,

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.

[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.