Bestimmtes Arbeitsblatt drucken ohne Datei zu öffnen

[karsten-30]

Liebe Forum-User,
vielleicht ist jemand hier, der mir bei meinem Problem helfen kann. Ich habe bereits versucht über die Suchfunktion was zu finden, aber nichts passendes gefunden (oder falsch gesucht). Sollte das der Fall sein bitte ich um Entschuldigung und der Bitte um Hinweis, wo ich die Lösung finden kann. Ansonsten kommt nun mein Anliegen:

Die Situation:
Ich habe ein Verzeichnis mit bis zu 200 Excel-Dateien. Alle haben mindestens drei Arbeitsblätter, manche vier. Die Arbeitsblätter haben zum Teil unterschiedliche Namen.

Das Problem:
Ich suche nach einer Möglichkeit Arbeitsblätter nach Wahl aller Dateien auszudrucken. Zum Beispiel einmal nur das erste Arbeitsblatt, dann wieder nur das dritte und dann nur das vierte in jeder Datei, egal wie die Arbeitsblätter heißen. Das Script müsste auch in der Lage sein zur nächsten Datei ohne Fehlermeldung zu gehen, falls es kein 4. Arbeitsblatt gibt und, wenn möglich, ohne das die Dateien immer geöffnet werden. Das war´s schon.

Ich habe Null Ahnung von Scripten. Ich weiß, das ich mit dem Windows-Datei-Explorer durch Markieren der Dateien immer das erste Arbeitsblatt ausdrucken kann. Aber das hilft mir, wie gesagt, nur wenig, da ich auch andere Arbeitsblätter in den Dateien ausdrucken will. Die bis zu 200 Dateien jedes Mal einzeln zu öffenen und dann das Arbeitsblatt anzuklicken und dann auf "Drucken" klicken  ist für mich mittlerweile zum Horror geworden.

Was ich benötige wäre ein Script, was beim Starten fragt, welche Arbeitsblätter in jeder Datei im gleichen Verzeichnis ausgedruckt werden sollen. Also zB gebe ich mal "1" für immer das 1. Arbeitsblatt ein, oder "3" für immer das Dritte Arbeitsblatt usw. Und wie gesagt, falls es dieses Arbeitsblatt nicht gibt, ignoriere den Fehler und gehe zur nächsten Datei.

Kann mir jemand hier bei meinem Problem helfen? Schon mal Danke im Voraus.

Liebe Grüße

Karsten

[shift-del]

Moin Karsten

Offenbar passt deine Mappen/Blatt-Struktur nicht zu deiner Arbeitsweise.
Warum hast du nicht vier Mappen mit 200 Blättern? Das käme deiner Arbeitsweise entgegen.

[RPP63]

Moin!
Mal sehen, ob Du mit meinen Ausführungen bereits klar kommst.
Um ein Blatt einer Datei, die nicht sichtbar ist, zu drucken, kannst Du Dich der GetObject-Funktion bedienen.

Sub RPP()
Dim Datei As Workbook
Set Datei = GetObject("I:\aktueller Stand\Übung\Autofilter.xlsx")
Datei.Worksheets(1).PrintOut
End Sub

Alle Dateien eines Verzeichnisses kannst Du mit einer Schleife mittels FileSystemObject auslesen:

Sub FSO()
Dim FileSystem As Object
Dim Verzeichnis As Object
Dim Dateienliste As Object
Dim Datei As Object

Set FileSystem = CreateObject("scripting.FileSystemObject")
Set Verzeichnis = FileSystem.GetFolder("I:\aktueller Stand\Übung")
Set Dateienliste = Verzeichnis.Files

For Each Datei In Dateienliste
  If Not Datei Is Nothing Then Debug.Print Datei.Name
Next Datei
End Sub

Jetzt musst Du das nur noch miteinander verwursten.

Gruß Ralf

[00202]

Hallo Karsten, :19:

prinzipiell so: :21:

Code:

Option Explicit
Public Sub Main()
    Dim strVerzeichnis As String
    Dim wkbBookTMP As Workbook
    Dim strFileName As String
    Dim varInput As Variant
    Dim strPath As String
    On Error GoTo Fin
    If fncOrdner(strVerzeichnis) <> "" Then
        ' Pfad anpassen!!!
        'strPath = "C:\Temp\"
        strPath = strVerzeichnis
        If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
        varInput = Application.InputBox(prompt:="Welches Arbeitsblatt?", Title:="Eingabe Zahl", Default:=2, Type:=1)
        If VarType(varInput) <> vbBoolean Then
            With Application
                .ScreenUpdating = False
                .EnableEvents = False
                .DisplayAlerts = False
                .AskToUpdateLinks = False
            End With
            strFileName = Dir$(strPath & "*.xls*")
            Do While strFileName <> ""
                If Not strFileName = ThisWorkbook.Name Then
                    Set wkbBookTMP = GetObject(strPath & strFileName)
                    'Workbooks.Open strPath & strFileName
                    With wkbBookTMP
                        If fncTab(Workbooks(strFileName), varInput) = True Then
                            .Worksheets(varInput).PrintOut
                        End If
                        .Close False
                        Set wkbBookTMP = Nothing
                    End With
                End If
                strFileName = Dir$()
            Loop
        End If
    End If
Fin:
    Set wkbBookTMP = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .AskToUpdateLinks = True
    End With
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub
Public Sub Main_1()
    Dim strVerzeichnis As String
    Dim wkbBookTMP As Workbook
    Dim strFileName As String
    Dim varInput As Variant
    Dim strPath As String
    On Error GoTo Fin
    'If fncOrdner(strVerzeichnis) <> "" Then
        ' Pfad anpassen!!!
        'strPath = ThisWorkbook.Path
        strPath = "C:\Temp\"
        'strPath = strVerzeichnis
        If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
        varInput = Application.InputBox(prompt:="Welches Arbeitsblatt?", Title:="Eingabe Zahl", Default:=2, Type:=1)
        If VarType(varInput) <> vbBoolean Then
            With Application
                .ScreenUpdating = False
                .EnableEvents = False
                .DisplayAlerts = False
                .AskToUpdateLinks = False
            End With
            strFileName = Dir$(strPath & "*.xls*")
            Do While strFileName <> ""
                If Not strFileName = ThisWorkbook.Name Then
                    Set wkbBookTMP = GetObject(strPath & strFileName)
                    'Workbooks.Open strPath & strFileName
                    With wkbBookTMP
                        If fncTab(Workbooks(strFileName), varInput) = True Then
                            .Worksheets(varInput).PrintOut
                        End If
                        .Close False
                        Set wkbBookTMP = Nothing
                    End With
                End If
                strFileName = Dir$()
            Loop
        End If
    'End If
Fin:
    Set wkbBookTMP = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .AskToUpdateLinks = True
    End With
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub
Public Function fncOrdner(strOrdner As String) As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"
        .Title = "Ordnerauswahl"
        .ButtonName = "Auswahl..."
        .InitialView = msoFileDialogViewList
        If .Show = -1 Then
            strOrdner = .SelectedItems(1)
            If Right(strOrdner, 1) <> "\" Then strOrdner = strOrdner & "\"
        Else
            Exit Function
        End If
    End With
    fncOrdner = strOrdner
End Function
Public Function fncTab(ByVal wkbBook As Workbook, ByVal lngTab As Long) As Boolean
    Dim wksSheet As Worksheet
    For Each wksSheet In wkbBook.Worksheets
        If wksSheet.Index = lngTab Then
            fncTab = True
            Exit Function
        End If
    Next wksSheet
End Function

Probiere es zunächst an einem Ordner mit nur wenigen Dateien aus. :21:

In "Main" hast du einen Ordnerauswahldialog.
In "Main_1" wird ein fester Pfad vorgegeben.

Du kannst auch mit dem gleichen Pfad wie die Exceldatei mit dem Code arbeiten "strPath = ThisWorkbook.Path". Dazu die entsprechende Codezeile aktivieren und "strPath = "C:\Temp\"" auskommentieren.

[RPP63]

Da ich auch ein wenig Langeweile hatte, mal mein Vorschlag:  :21:

Sub Blattdruck_RPP()
Dim Pfad$
Dim FileSystem As Object
Dim Verzeichnis As Object
Dim Dateienliste As Object
Dim Datei As Object
Dim Blatt_Nr&
Dim Mappe As Workbook

  'Ordner festlegen 
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = "I:\aktueller Stand\"
    .Title = "Ordnerauswahl"
    .ButtonName = "Auswahl …"
    .InitialView = msoFileDialogViewList
    If .Show = -1 Then Pfad = .SelectedItems(1)
    If Pfad = vbNullString Then
      MsgBox "Kein Pfad ausgewählt!" & vbNewLine & vbNewLine & _
            "Programm wird abgebrochen!", vbCritical
      Exit Sub
    End If
  End With
  
  'Blattauswahl festlegen 
  Blatt_Nr = Application.InputBox( _
            "Welches Blatt soll ausgedruckt werden?", _
            Default:=1, Type:=1)

  'Ausdruck des n-ten Blatts 
  Set FileSystem = CreateObject("scripting.FileSystemObject")
  Set Verzeichnis = FileSystem.GetFolder(Pfad)
  Set Dateienliste = Verzeichnis.Files
  
  For Each Datei In Dateienliste
    On Error Resume Next
    If Not Datei Is Nothing Then
      Set Mappe = GetObject(Pfad & "\" & Datei.Name)
      Mappe.Worksheets(Blatt_Nr).PrintOut
    End If
    On Error GoTo 0
  Next Datei

End Sub

---

Dass Case die Events ausschaltet, macht natürlich Sinn!
Schließlich könnten ja umfangreiche _Open-Events laufen …

[karsten-30]

Hallo zusammen,
zuerst einmal ein ganz großes DANKESCHÖN an Euch. Ihr helft mir SEHR damit. Ich kam leider nicht früher dazu zu antworten, da ich gerade berufsmäßig landunter habe.

@ shift-del: Das sind alles Kundendateien mit Messwerten drin. Jeder Kunde hat x Anzahl an Geräten (x Anzahl an Dateien). Es gibt Kunden mit 30 Geräten, andere haben 300+, wobei manche nicht jährlich geprüft werden müssen. Und am Ende brauche ich einen Ausdruck von Messwerten, die immer auf der 1. und 3. Seite eines Arbeitsblatts sind, manchmal sogar auf einer 4, wenn ein Gerät Zusatzmessungen hat. Die Dateinamen sind verschieden. Wenn ich zB. zuerst mir von allen Dateien das erste Blatt ausdrucken lasse, nehme ich dann diesen Packen und schicke ihn an Adresse A. Danach drucke ich alle 3. Seiten und nehme den Packen und schicke ihn an Adresse B. Danach drucke ich alle 4. Seiten und hefte sie bei mir ab.

@ Case und Ralf: Ich werde Euer Script zum Wochenende ausprobieren, da ich vorher nicht dazu komme. Danach gebe ich bescheid.

Nochmals vielen Dank vorab an Euch alle !!! Bis dann...

Karsten

[karsten-30]

Hallo Ralf,
erst einmal vorab ein dickes Dankeschön. Es funktioniert soweit. Aaaber: Wenn das Blatt der letzten Datei ausgedruckt wurde, egal ob ich Mappe 1 oder 3 wähle, druckt es mir danach noch einige Male dieses Blatt von der letzten Datei aus. ZB habe ich bei 8 Dateien im Testverzeichnis mal Arbeitsblatt 3 gewählt, und von der letzten Datei wurde es mir 18 weitere Male ausgedruckt. Scheint, als ob nach der letzten gefundenen Datei nicht aufgehört wird. Und es ist abhängig wie viele Dateien in diesem Verzeichnis sind. Wenn es nur 3-4 Dateien sind, druckt er mir nur 1x mehr aus. Wenn es 8 sind erhöht sich es schon auf 8 bis 18. Den Test mit 200 Dateien lasse ich erst mal...

Wenn ich dann die Datei, wo ich das VBA-Script ausgeführt habe, schließen will, nachdem alles fertig ist,  werde ich für jede Datei gefragt, ob ich die Änderungen abspeichern will. Bei 200 Dateien ... uff...

Dann eine weitere Frage: Besteht die Möglichkeit dieses Script noch etwas aufzubohren in dem Sinne, das statt des Ausdruckens nun eine PDF abgespeichert wird? Also in der Form, das man einen Automatismus hat, der das gewählte Arbeitsblatt statt zum Drucker nun in ein PDF umwandelt und unter dem gleichen Dateinamen dieses Arbeitsblatt abspeichert?

Und noch eine Frage:
Wie speichere ich Dein Script ab? Ich gehe bisher den Weg, das ich "Alt-F11" drücke. In dem nun gezeigten Visual Basic Editor (oder was immer das ist) gehe ich oben auf "Einfügen -> Modul". Dort kopiere ich Deinen Code hinein und starte ihn mit F5. Aber wenn ich die Datei schließe ist logischerweise wieder alles weg und ich muss das jedes Mal neu machen.

Hoffentlich mache ich Dir jetzt nicht zu viel Arbeit oder nerve Dich mit meinen Fragen und Anliegen  

Gruß

Karsten

[RPP63]

Nimm lieber den Code von Case!
Der ist ausgereifter und berücksichtigt vor allem das Schließen der per GetObject temporär "unsichtbar" geöffneten Datei.

Aber wenn ich die Datei schließe ist logischerweise wieder alles weg und ich muss das jedes Mal neu machen.

Zunächst mal war Dein Ablauf korrekt.
Du musst die Datei aber als .xlsm oder .xlsb abspeichern, damit das Makro erhalten bleibt.

Gruß Ralf