Ich sammle mit einer UserForm die entsprechenden Excel-Sheets, die in ein PDF zusammengefasst werden sollen.

Nun wurde bei uns von Excel 10 auf Excel 21 umgestellt und prompt geht einiges nicht mehr. Mein jetziges Problem betrifft die PDF-Erstellung über VBA. Hier habe ich in den Excel-Sheets einige Felder mit Farben unterlegt und es kommt je nach Seite und Farbe skurille PDF's raus.
Statt Hellbraun und beige oder Schwarz und grün wird alles grau abgestuft.
Wisst ihr woran das liegt?

Hier mein Code für das Sammeln der Blätter:

Public Sub ArrayFüllen_chkMaschinenkarte()
'Ein Array deklarieren mit i Einträgen (Index maximal von 0 bis 4, minimal 0)
Dim Anzahl&

VariableBlätter = ""

'** Festlegen, welche Tabellenblätter gedruckt werden sollen, nur die mit Haken
If UFDrucken.chkDeckblatt.Value = True Then
With Worksheets(1).PageSetup
.Orientation = xlPortrait 'Hochformat einstellen (=1)
'****** ÄNDERUNGEN
.PrintArea = "$A$1:$H$70"
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.RightHeader = ""
.LeftHeader = ""
.CenterHeader = ""
.RightFooter = ""
.LeftFooter = ""
.CenterFooter = ""
End With
VariableBlätter = Worksheets(1).Name & ";" 'Deckblatt einfügen
End If

If UFDrucken.chkTermine.Value = True Then
With Worksheets(2).PageSetup
.Orientation = 1 'Hochformat einstellen
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
VariableBlätter = VariableBlätter & Worksheets(2).Name & ";" ' Termine einfügen
End If

If UFDrucken.chkStandard.Value = True Then
Select Case True
Case Worksheets(3).Columns("D").EntireColumn.Hidden 'Standard eingekürzt ohne Erklärungen
With Worksheets(3).PageSetup
.Orientation = 1 'Hochformat einstellen
'****** ÄNDERUNGEN
.PrintArea = "$A$1:$G$55"
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Case Else 'Standard nicht eingekürzt, also mit Erklärungen
With Worksheets(3).PageSetup
.Orientation = 2 'Querformat einstellen
'****** ÄNDERUNGEN
.PrintArea = "$A$1:$G$55"
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End Select
VariableBlätter = VariableBlätter & Worksheets(3).Name & ";" 'Standardbaugruppen einfügen
End If

If UFDrucken.chkOptionen.Value = True Then
Select Case True
Case Worksheets(4).Columns("D").EntireColumn.Hidden 'Optionen eingekürzt ohne Erklärungen
With Worksheets(4).PageSetup
.Orientation = 1 'Hochformat einstellen
'****** ÄNDERUNGEN
.PrintArea = "$A$1:$G$50"
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Case Else 'Optionen nicht eingekürzt, also mit Erklärungen
With Worksheets(4).PageSetup
.Orientation = 2 'Querformat einstellen
'****** ÄNDERUNGEN
.PrintArea = "$A$1:$G$50"
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End Select
VariableBlätter = VariableBlätter & Worksheets(4).Name & ";" 'Optionsbaugruppen einfügen
End If

If UFDrucken.chkTypenschild.Value = True Then
With Worksheets(5).PageSetup
.Orientation = 1 'Hochformat einstellen
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
VariableBlätter = VariableBlätter & Worksheets(5).Name & ";" 'Typenschild einfügen
End If

If VariableBlätter = "" Then
Drucksammlung = Split(VariableBlätter, ";") 'Split-Funktion macht aus der String-Variablen 'VariableBlätter' einen 1D-Array
Else
Anzahl = Len(VariableBlätter) 'Bestimmung der Länge des Strings
VariableBlätter = Left(VariableBlätter, Anzahl - 1) 'Löschen des letzten Semikolons

Drucksammlung = Split(VariableBlätter, ";") 'Split-Funktion macht aus der String-Variablen 'VariableBlätter' einen 1D-Array
End If

End Sub

Und hier der Code für den Druckbefehl:

Public Sub Maschinenkarte_PDFundDrucken()
Dim SpeicherName As String
Dim Speicherpfad As String

'PDF erstellen, Speicherort auswählen und abspeichern, PDF öffnen und über den Viewer drucken
On Error GoTo Fehler

'Speichername und SpeicherPfad angeben, wo normalerweise gespeichert wird
SpeicherName = InputBox("Wie soll die Datei heißen?", "Speichername angeben", "MaschinenkarteXY")

If SpeicherName = "" Then
MsgBox "Kein Name zum Speichern angegeben", vbCritical, "Konfigurator wird jetzt geschlossen"
Exit Sub
End If

'Abfrage des Speicherpfades --> Speichern unter
If MsgBox(prompt:="Möchtest du die Maschinenkarte nun speichern?", Buttons:=vbYesNo _
+ vbQuestion, Title:="Speichern?") = vbNo Then Exit Sub
Speicherpfad = Application.GetSaveAsFilename( _
InitialFileName:="W:\" & SpeicherName, _
FileFilter:="PDF-Datei (*.pdf),*.pdf", _
Title:="Speicherpfad auswählen oder eingeben")
'Übertragung des gewünschten Speichernamens, des gewünschten Dateiformates und Titel des Fensters

Application.EnableEvents = False

Sheets(Drucksammlung).Copy
'hier befinden sich nur noch die ausgewählten Checkbox-Elemente in einer temporären Arbeitsmappe

MsgBox "Drucken bitte über den PDF-Viewer starten!", vbOKOnly + vbExclamation, "Druckauftrag einleiten"

With ActiveWorkbook
.ExportAsFixedFormat Type:=xlTypePDF, FileName:=SpeicherName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
.Close SaveChanges:=False 'Temporäre Arbeitsmappe wird geschlossen
End With

Application.EnableEvents = True

Exit Sub

Fehler:
MsgBox "Da ist wohl was schief gelaufen (Prozedur Maschinenkarte_PDFundDrucken)", vbInformation

End Sub