Hallo Ihr Spezialisten,

ich bastele zur Zeit an einem Aufmaßprogramm, das Rechnet als auch Zeichnungen erstellt, für unsere Mitarbeiter, aber aufwendig in der Ausgabe an den Kunden.

Da die Exceldatei sehr gro0 ist, dachte ich mir, dem Kunden nur PDF zu überlassen, dachte das wäre einfach.

Die Aufmaß-Ausgabe umfasst, wenn wirklich alles genutzt wird über 50 Seiten, da das viel zuviel ist, habe ich ein Makro gebaut mit dem ich die benutzten Seiten selektieren kann, was auch gut funktioniert, NUR

Sub Drucken_1bis20()
Application.ScreenUpdating = False
Dim ArrSuch, ArrBlatt, i As Integer, Bereich As String, Vorgabe As String, Datei As String, SW As String
Dim DatName As String
Sheets("Multiprojekte").Select
DatName = Range("BC1")
Sheets("Ausgabe an Kunde Multi").Select
Range("BB1").Select
' If Range("BB1") > 1284 Then GoTo Aufteilen

SW = "b" 'Suchwort
' Übersi.1 Übersi.2 Übersi.3 Übersi.4 Zusammenf. Anschluß Weg1 Weg2 Weg3 Weg4 Weg5 Weg6 Weg7 Weg8 Weg9 Weg10 Weg11 Weg12 Weg13 Weg14 Weg15
ArrBlatt = Array("A1:AX57", "A58:AX114", "A115:AX170", "A171:AX226") ', "A227:AX282", "A283:AX347", "A348:AX414", "A415:AX481", "A482:AX548", "A549:AX615", "A616:AX682", "A683:AX749", "A750:AX816", "A817:AX883", "A884:AX950", "A951:AX1017", "A1018:AX1084", "A1085:AX1151", "A1152:AX1218", "A1219:AX1285") ', "A1286:AX1352", "A1353:AX1419", "A1420:AX1486", "A1487:AX1553", "A1554:AX1620", "A1621:AX1687", "A1688:AX1754", "A1755:AX1821", "A1822:AX1888", "A1889:AX1955", "A1956:AX2022", "A2023:AX2089", "A2090:AX2156", "A2157:AX2223", "A2224:AX2290", "A2291:AX2357", "A2358:AX", "A2423:AX2489", "A2490:AX2556")
' Über.1 Über.2 Über.3 Über.4 Zusam. Anschluß Weg1 Weg2 Weg3 Weg4 Weg5 Weg6 Weg7 Weg8 Weg9 Weg10 Weg11 Weg12 Weg13 Weg14 Weg15
ArrSuch = Array("BC16", "BC73", "BC130", "BC186") ', "BC242", "BC298", "BC363", "BC430", "BC497", "BC564", "BC631", "BC698", "BC765", "BC832", "BC899", "BC966", "BC1033", "BC1100", "BC1167", "BC1234") ', "BC1301", "BC1368", "BC1435", "BC1502", "BC1569", "BC1636", "BC1703", "BC1770", "BC1837", "BC1971", "BC2038", "BC2105", "BC2171", "BC2239", "BC2306", "BC2373", "BC", "BC2450", "BC2520") 'Prüfbereiche zur Seitenwahl
'Gleiche Anzahl an Einträgen


With ActiveSheet.PageSetup
'Reset
.PrintArea = ""
Bereich = ""

For i = LBound(ArrBlatt) To UBound(ArrBlatt)
If Range(ArrSuch(i)) = SW Then
Bereich = Bereich & "," & ArrBlatt(i)
End If
Next

End With
With ActiveSheet.PageSetup
PrintArea = Mid(Bereich, 2)
End With

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DatName, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

die letzte Zeile bereitet mir Kopfschmerzen.
Die erste Ausgabeseite hat 57 Zeilen, wähle ich den Druckbereich nur auf sie und drucke dann als PDF, benötigt das dann ca. 20 Sekunden !
Lasse ich mein Makro laufen, wählt mir dieses die PrintArea = A1:AX57 und schreitet weiter zur letzten Zeile.
Im Explorer wird ein TMP angezeigt, nach einiger Zeit kommt ein kleines Anzeigefenster mit "wird veröffentlich" und einer Balkenanzeige
Nur passieren tut nix
Ich will hoffen das ich das Bildschirmfoto hier veröffentlich bekomme, nach 18 Minuten hatte der Balken vielleicht 5%

Wisst Ihr was ich tun kann ? Printbereich klappt, nur die Ausgabe als PDF hängt.
Das Bildschirmfoto wurde unter 179554.png gespeichert, die PDF der ersten Seite ist leider nicht zulässig