van alle bestanden uit een dir bepaalde pagina's printen

[GerV]

Dit is een vervolgvraag op het printen van bepaalde tabbladen.

Ik kwam een code tegen van HSV waarin een bepaalde bewerking op alle bestanden in een dir werd toegepast. Omdat mijn print opdracht ook voor alle bestanden in een dir geldt leek het mij zinvol en gemakkelijker om deze code ook te gebruiken.
Dit is wat ik ervan gebrouwen heb, maar omdat ik niet alle commando's begrijp lukt het mij niet om het werkend te krijgen. Ik kan zien dat het eerste bestand wordt "geladen".

Opmerking: de bestanden waaruit geprint moet worden zijn beveiligd en moeten als alleen lezen geopend worden.

Sub hsv()
Dim Bestandopen As String, naam As String, blz1 As String, blz2 As String
blz1 = Sheets("Blad1").Range("a2").Value
blz2 = Sheets("Blad1").Range("b2").Value
With Application
   .DisplayAlerts = False
   .ScreenUpdating = False
   .EnableEvents = False
   
Bestandopen = Dir("u:\testmap\*")
Do Until Bestandopen = ""
      If Bestandopen <> ThisWorkbook.Name Then
       Workbooks(Bestandopen).Sheets(blz1).PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    Workbooks(Bestandopen).Sheets(blz2).PrintOut Copies:=1, Collate:=True, _
      IgnorePrintAreas:=False
            Workbooks(Bestandopen).Close False
        End If
     Bestandopen = Dir
    Loop .DisplayAlerts = True
 .EnableEvents = True
End With
End Sub

 

[GerV]

Voor de volledigheid:

Hier heb ik de code gevonden die ik wil aanpassen aan mijn behoefte.

http://www.helpmij.nl/forum/showthread.php/867079-samenvoegen-excel-bestanden-in-bepaalde-directory

Ger V

 

[VenA]

Ik zou eens beginnen met de beveiligingen van de bestanden af te halen. Je kan ook met <F8> door de code wandelen om te zien waar het fout gaat.

 

[GerV]

Na wat experimenteren en fijn slijpen is het gelukt (hieronder de code voor 1 week printen) zonder de beveiligingen eraf te gooien.
HSV bedankt voor de originele code waarop dit gebaseerd is.

Sub hsv()
Dim Bestandopen As String, naam As String, blz1 As String


With Application
   .DisplayAlerts = False
   .ScreenUpdating = False
   .EnableEvents = False
blz1 = InputBox("welke week moet geprint worden:")
    ' zorgen dat een nummer wordt ingevoerd
    If Not IsNumeric(blz1) Then
    MsgBox "je moet een cijfer invoeren."
    Exit Sub
    End If
     ' zorgen dat het een positief nummer is
    If blz1 < 0 Then
    MsgBox "geef een positief getal op"
    Exit Sub
    End If

   
Bestandopen = Dir("J:\Zuid\ZML\VPM\Verlofboeken ZML 2015\*.xlsm")
Do Until Bestandopen = ""
      If Bestandopen <> ThisWorkbook.Name Then
Workbooks.Open "J:\Zuid\ZML\VPM\Verlofboeken ZML 2015\" & Bestandopen, Notify:=False, ReadOnly:=True, UpdateLinks:=0
        Sheets(blz1).Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
       IgnorePrintAreas:=False
            Workbooks(Bestandopen).Close True
        End If
     Bestandopen = Dir
    Loop
 .DisplayAlerts = True
 .EnableEvents = True
End With
End Sub

 

[VenA]

Goed bezig:thumb:

Eventueel de foute invoer afhandelen met zoiets.

blz1 = InputBox("welke week moet geprint worden:")
    If Not IsNumeric(blz1) Or blz1 < 0 Or blz1 > 53 Then
        MsgBox "Dit is geen geldig weeknummer."
        Exit Sub
    End If

 

[GerV]

Bedankt voor de tip. Zal het aanpassen.

Ger V