Alle Tabellenblätter bis auf die ersten zwei Ausdrucken oder als einzel-PDF speichern

[kliffi01]

Hallo und guten Morgen,

ich wünsche Euch einen guten Start ins neue Jahr 2018.

Gerade scheitere ich an folgendem Problem und ersuche eure Hilfe.
In meiner Exceldatei habe ich immer das Sheet "Start" und "Vorl.". Über ein paar Eingaben in Start, schreiben sich werte in "Vorl." und durch Betätigen einer Schaltfläche wird ein Protokoll erzeugt, mit neuem Tabellenblatt-Namen. So kann es sein, dass ich am Ende der Erstellung der Protokolle bis zu 50 Tabellenblätter habe.

Ich würde nun gerne eine Schaltfläche oder UserForm erzeugen mit der ich jedes Blatt als PDF drucken kann. Der Dateiname soll dem Blattnamen entsprechen. Der Speichertort könnte man schon vorher auswählen, sodass er sich vllt. in eine ausgeblendete Zelle schreibt oder man wählt ihn im Makro aus.

Meine bisherige Herangehensweise war diese Überlegung:
Damit habe ich es geschafft die Blätter "Start" und "Vorl." auszublenden, dann alle Blätter zu markieren, um sie abschließend wieder einzublenden und die Markierung aufzuheben.

Code:

Sub BlaetterDrucken()
    Sheets("Start").Visible = xlSheetVeryHidden
    Sheets("Vorl.").Visible = xlSheetVeryHidden
    
    Dim mySheet As Object
    For Each mySheet In Sheets
        With mySheet
            If .Visible = True Then .Select Replace:=False
        End With
    Next mySheet
    
    Sheets("Start").Visible = xlSheetVisible
    Sheets("Vorl.").Visible = xlSheetVisible
End Sub

Jetzt komme ich nicht weiter, hier enden meine Kenntnisse.

Ich freue mich über eure Vorschläge und Anregungen und verbleibe dankend!
Grüße aus Stuttgart
Martin

[RPP63]

So kann es sein, dass ich am Ende der Erstellung der Protokolle bis zu 50 Tabellenblätter habe.

Moin!
Bist Du Dir sicher, dass dies notwendig ist?
Ohne die Datei nebst übrigem Code zu kennen, bleibt nur folgende Mutmaßung:
In der zweifellos vorhandenen Schleife kannst Du eine temporäre gefüllte Kopie der Vorlage erstellen und sie entweder per .PrintOut oder .ExportAsFixedFormat xlTypePDF drucken oder als PDF erstellen.
Gruß Ralf

[kliffi01]

Hallo Ralf,

bisher würde ich auf deine Frage ja antworten. Pro Protokoll ein Tabellenblatt (Pro Auftragsart quasi eine Datei mit mehreren Auftragsprotokollen). Wenn ich sie zerstückele führt das zu Irritationen der Beteiligten. Oder hast du anders gedacht als ich?

Ich dachte ich könnte nun mit

Code:

With mysheet.ExportAsFixedFormat
end with

arbeiten, aber das passt nicht. Da kommt im VBA schon "Erwartet: Ausdruck". Muss der Code noch in der Schleife eingebaut werden, vor "next mySheet" oder danach?

[Case]

Hallo, :19:

... Beispiel werden alle Tabellenblätter außer die ersten beiden im gleichen Verzeichnis wie die Exceldatei und jeweils mit Namen des Tabellenblattes gespeichert:

Code:

Option Explicit
Sub Main()
    Dim wksSheet As Worksheet
    On Error GoTo Fin
    For Each wksSheet In ThisWorkbook.Worksheets
        With wksSheet
            If .Index > 2 Then
                .ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & .Name
            End If
        End With
    Next wksSheet
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

[kliffi01]

Hallo Case und vielen Dank für deine Antwort.
Habe es soweit eingebaut und es funktioniert ohne zu murren.
In den erstellten Protokollen gibt es Zellen, welche ihren Inhalt aus UserForm-Eingaben beziehen. In den Feldern der UserForm habe ich Zeilenumbrüche eingebaut, gerade bei Adresse. Diese Zeilenumbrüche werden im erstellten PDF mit einem rechteckumrahmten ? angezeigt. Hast du dazu eine Idee? Kompilierungsparameter?
Siehe Anhang.

[Case]

Hallo, :19:

das könnte an der Schriftart liegen. Probiere mal eine andere z. B. Arial.

Eventuell könnte auch ein "Replace" bei der Übergabe der Daten in das Tabellenblatt helfen:

Code:

Tabelle1.Range("A1").Value = Replace(TextBox1.Value, vbCrLf, vbLf)

Soweit ich in Erinnerung habe erzeugt ein Zeilenumbruch in der TextBox der UserForm "vbCrLf" also Return und Zeilenvorschub - im Tabellenbaltt aber nur ein "vbLf" sprich einen Zeilenvorschub.

Teste mal mit den beiden Möglichkeiten.

[kliffi01]

Guten Morgen,

ich bin um der Möglichkeiten begeistert [img]
Dateiupload bitte im Forum! So geht es: Klick mich!
].
Es funktioniert mit der Schriftart Arial, aber eine andere Schriftart in unserem Firmendesign - das passt nicht.
Deshalb habe ich deinen Code verwendet und etwas umbasteln müssen:

Code:

Range("H5").Value = Replace(Range("H5").Value, vbCrLf, vbLf)

Damit funktioniert es genau wie es soll. Danke dir!

Die Textbox1 heißt bei mir RBAdresse1, zumindest habe ich so in der UserForm im Parameter (Name) benannt. Leider hat er mit

Code:

Range("H5").Value = Replace(RBAdresse1.Value, vbCrLf, vbLf)

einen Fehler erzeugt.

Jetzt bräuchte ich noch ein wenig Starthilfe wie ich die PDFs nicht in das selbe Verzeichnis, sondern in einen Ordner mit dem Namen der Zelle C12 exportieren kann. Mein bisheriger, nicht funktionierender Versuch mit "dim sEKDatum As String" das Datum der Variable sEKDatum zu zuweisen. Jetzt möchte ich einen Ordner erstellen lassen der den Namen der Variablen trägt. Geht das?

Code:

Private Sub BlaetterDrucken2()
   Dim wksSheet As Worksheet
   Dim vEKDatum As String
   
   vEKDatum = Range("Start!C12")
       On Error GoTo Fin
             
       For Each wksSheet In ThisWorkbook.Worksheets
       With wksSheet
           If .Index > 2 Then
               .ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & .Name
           End If
       End With
       Next wksSheet
       
       MsgBox "Alle EK-Protokolle erfolgreich als PDF ausgegeben!"
Fin:
   If Err.Number <> 0 Then MsgBox "Error: " & _
       Err.Number & " " & Err.Description
End Sub

[Case]

Hallo, :19:

dazu ein paar Fragen:

1. Was genau steht in C12?
2. Ist es C12 des jeweiligen Tabellenblattes? 
3. Also u. U. immer ein anderer Ordner für jede PDF?

Gib bitte einfach noch ein paar Infos.

[kliffi01]

Hi,

in C12 steht ein Datum im Format 04.01.18. Es steht in einem anderen Tabellenblatt "Start".
Nein, alle PDFs sollten in diesem Ordner /04.01.18/ landen

[Case]

Hallo, :19:

probiere es mal so:

Code:

Option Explicit
Private Declare PtrSafe Function MakeSureDirectoryPathExists _
    Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Private Sub BlaetterDrucken2()
    Dim wksSheet As Worksheet
    Dim strTMP As String
    On Error GoTo Fin
    strTMP = "C:\Temp\" & ThisWorkbook.Worksheets("Start").Range("C12").Value & "\"
    MakeSureDirectoryPathExists strTMP
    For Each wksSheet In ThisWorkbook.Worksheets
        With wksSheet
            If .Index > 2 Then
                .ExportAsFixedFormat 0, strTMP & .Name
            End If
        End With
    Next wksSheet
    MsgBox "Alle EK-Protokolle erfolgreich als PDF ausgegeben!"
Fin:
   If Err.Number <> 0 Then MsgBox "Error: " & _
       Err.Number & " " & Err.Description
End Sub

"C:\Temp\" musst Du noch anpassen. Abschließenden Backslash nicht vergessen.