• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Meerdere bestanden tegelijk printen

Status
Niet open voor verdere reacties.

Robjuh20

Gebruiker
Lid geworden
3 mei 2012
Berichten
28
Beste HelpMij'ers,

Ik heb weer een vraag. Ik wil graag een macro maken waarmee ik meerdere bestanden tegelijk kan uitprinten. Het liefste wil ik een range van deze bestanden kunnen bepalen, dus:

- Een invulveld met de naam van het eerste bestand dat uitgeprint moet worden.
- Een invuldveld met de naam van het laatste bestand dat uitgeprint moet worden.

Nu wil ik hier een macro op gaan schrijven dat er een print wordt gemaakt van deze tussenliggende bestanden.

Alvast bedankt voor het delen van jullie kennis en mocht het niet duidelijk zijn, dan hoor ik dat graag!
 
Mss komt dit in de richting.
Code:
Public Sub Printen()
    
    Dim sPath As String, sFileName As String, sFileMask As String
    Dim sFile1 As String, sFile2 As String
    Dim i As Long
    
    sPath = ActiveWorkbook.Path & "\"
    sFileMask = "Test*.xls"
    sFile1 = "Test1.xls"
    sFile2 = "Test3.xls"
    
    sFileName = Dir(sPath & sFileMask)
    Do Until sFileName = ""
        If sFileName >= sFile1 And sFileName <= sFile2 Then
            With Workbooks.Open(Filename:=sPath & sFileName)
                .Sheets.Select
                .PrintPreview
                .Close
            End With
        End If
        sFileName = Dir
    Loop
    
End Sub
 
Beste Frans,

Even voor mijn duidelijkheid:
- sPath = het pad waar het document te vinden is (aangezien dit niet hetzelfde is als waar de documenten staan, kan ik deze ook statisch toevoegen?)
- sFileMask = ?
- sFile1 = de naam van het 1e bestand
- sFile2 = de naam van het 2e bestand

Ik denk dat ik de logica van de macro wel snap. Maar dan komt het volgende probleem, de documenten zijn niet op nummers of dergelijke, het zijn namen waar geen vergelijkbare volgorde aan te hangen is. Is dit een probleem? Alvast bedankt voor de reactie!
 
Laatst bewerkt:
Filemask kun je zien als een voorselectie. Als je alleen xls bestanden wilt verwerken kies je als mask *.xls. Stap met F8 door de code en kijk welke bestanden wel worden gelezen en welke niet.
Je andere twee vragen heb je inmiddels vast zelf al beantwoord door te proberen.
 
Nu heb ik dit:

Code:
Sub Printen()
Dim sPath As String, sFileName As String, sFileMask As String
    Dim sFile1 As String, sFile2 As String
    Dim i As Long
    
    sPath = "H:\Bestelbon naar factuur v2\Klantfacturatie\"
    sFileMask = "*.xlsx"
    sFile1 = "H:\Bestelbon naar factuur v2\Klantfacturatie\" & Range("E3").Value & ".xlsx"
    sFile2 = "H:\Bestelbon naar factuur v2\Klantfacturatie\" & Range("E5").Value & ".xlsx"
    
    sFileName = Dir(sPath & sFileMask)
    Do Until sFileName = ""
        If sFileName >= sFile1 And sFileName <= sFile2 Then
            With Workbooks.Open(Filename:=sPath & sFileName)
                .Sheets.Select
                .PrintPreview
                .Close
            End With
        End If
        sFileName = Dir
    Loop 
End Sub

Ik heb 3 bestanden aangemaakt, namelijk Kakelbont, Kiekeboe en Legosteen... Ik heb opgegeven dat het tussen Kakelbont en Legosteen moet liggen, maar dit doet hij niet.. Dit heeft denk ik te maken met die mask, dat snap ik niet helemaal.
 
Laatst bewerkt door een moderator:
Stap door de code met F8. Als je bij de If bent hou dan je muiscursor op de variabelen en kijk wat er in staat.
Spoiler: in file1 en file2 moet je geen pad opgeven, alleen de bestandsnaam.
 
Ik heb hem werkend, super bedankt! Maar nu heb ik nog 1 vraag. Hij vraagt nu iedere keer of ik het bestand wil opslaan, ja of nee (omdat hij veranderingen ziet en dit komt omdat al deze inhoud uit een ander bestand gehaald wordt). Dit wil ik eigenlijk vermijden. Kan dat met .save of iets?
 
Het is inmiddels helemaal gelukt, de code is uiteindelijk geworden:

Code:
Sub Printen()
Dim sPath As String, sFileName As String, sFileMask As String
    Dim sFile1 As String, sFile2 As String
    Dim i As Long
    
    sPath = "H:\Bestelbon naar factuur v2\Klantfacturatie\"
    sFileMask = "*.xlsx"
    sFile1 = Range("E3").Value & ".xlsx"
    sFile2 = Range("E5").Value & ".xlsx"
    
    sFileName = Dir(sPath & sFileMask)
    Do Until sFileName = ""
        If sFileName >= sFile1 And sFileName <= sFile2 Then
            With Workbooks.Open(Filename:=sPath & sFileName)
                .Sheets.Select
                .PrintOut ActivePrinter:="doPDF v7", Copies:=2, Collate:=True, _
                IgnorePrintAreas:=False
                .Save
                .Close
            End With
        End If
        sFileName = Dir
    Loop

End Sub

Altijd handig voor mensen die dit terug gaan lezen :). Iedereen bedankt!
 
Laatst bewerkt door een moderator:
Namens de teruglezers bedankt voor de terugkoppeling :). Nu nog tussen codetags en :) :) :)
Code:
Public Sub Printen()
    
    Dim sPath As String, sFileName As String, sFileMask As String
    Dim sFile1 As String, sFile2 As String
    Dim i As Long
    
    sPath = ActiveWorkbook.Path & "\"
    sFileMask = "*.xls"
    sFile1 = LCase("Test1.xls")
    sFile2 = LCase("Test3.xls")
    
    sFileName = LCase(Dir(sPath & sFileMask))
    Do Until sFileName = ""
        If sFileName >= sFile1 And sFileName <= sFile2 Then
            With Workbooks.Open(Filename:=sPath & sFileName)
                .Sheets.Select
                .PrintOut Preview:=True
                .Close SaveChanges:=False
            End With
        End If
        sFileName = LCase(Dir)
    Loop
    
End Sub
(Vier keer LCase toegevoegd om case-problemen te omzeilen)
 
Het probleem is uiteindelijk toch niet opgelost.

- Ik ben het nu aan het implementeren op de werkelijke lijst, maar deze gaat hij random na, niet in de volgorde zoals hij vermeld staat in Windows. Hoe kan ik dit aanpassen?
- Het lijkt er ook op dat hij kijkt naar alfabetische volgorde. Nu is deze lijst gesorteerd op de opmerkingen van het document (dus zoals je in Windows een document "opmerkingen" kan geven). Is hier iets mee te doen in Macro's? Zo ja, dan is het probleem al een heel stuk verder opgelost.
 
Laatst bewerkt:
Dir leest de bestanden in de volgorde zoals ze op schijf staan, dat is niet gesorteerd. Is op te lossen maar dan is het wel handig als je goede voorbeelden geeft van je bestandsnamen, en hoe je die gesorteerd wilt hebben. Toelichting/voorbeelden van die "opmerkingen" kan ook geen kwaad.
 
Bij deze een screenshot van hoe het er uitziet:

Naamloos.jpg

Je ziet dat de lijst gesorteerd is op 'opmerking'. Ik wil ook dat hij zo door de lijst heen gaat lopen. Dus als ik zeg dat hij moet printen tussen de bestanden Kroket en Legosteen, hij deze en de tussenliggende bestanden uitprint.
 
Die opmerking is een eigenschap van de file. In vba is geen standaard voorziening om dat te lezen, je zult van scripting (Filesystemobject) of van de shell gebruik moeten maken.
Gemakkelijker is om de code in je bestandsnaam op te nemen: B03-Kroket.xls
 
Dat is geen optie om de naam te veranderen, omdat dit nummer een routenummer is. Mocht er dan een document tussenkomen, moet ik de namen aan gaan passen, wat niet kan. Dit komt, omdat er een koppeling inzit die doorlinkt naar een ander bestand. Is het op een andere manier op te lossen?

Om het misschien simpeler te maken, het grote probleem is dat als ik ga printen, ik de bestanden selecteer en dan kies voor print. Dan print hij ze ook wel allemaal achter elkaar uit, maar hij vraagt dan steeds of ik de veranderingen wil opslaan. Dit is vervelend, want dan moet je er de hele tijd bij zijn.

Misschien is dit ook op een andere, simpelere manier op te lossen. Dan vergeten we het stuk dar ik een selectie maak, dat is dan natuurlijk ook mogelijk met dezelfde actie als hierboven beschreven.
 
De simpelste oplossing m.i. is een Userform met een multiselect-listbox erin, hierin een dir-list met alle bestanden, af te printen bestanden selecteren en dan via je eerdere code bestanden 1 voor 1 openen, afdrukken en sluiten zonder opslaan.
Benodigdheden:
1 Userform
1 Listbox
1 Commandbutton
onderstaande code in Userformmodule, nog enkel pad wijzigen bij Const
Code:
Const mydir = "G:\Mijn documenten\Helpmij\"

Private Sub UserForm_Initialize()
    Dim filelist()
    fName = Dir(mydir & "*.*")
    While fName <> ""
        I = I + 1
        ReDim Preserve filelist(1 To I)
        filelist(I) = fName
        fName = Dir()
    Wend
    With ListBox1
        .List = filelist()
        .MultiSelect = fmMultiSelectMulti
    End With
End Sub

Private Sub CommandButton1_Click()
    With ListBox1
        For I = 0 To .ListCount - 1
            If .Selected(I) Then
                With Workbooks.Open(mydir & .List(I))
                    .Sheets.Select
                    .PrintOut 'Preview:=True
                    .Close SaveChanges:=False
                End With
            End If
        Next I
    End With
End Sub
 
Laatst bewerkt:
@Rudi: fraaie oplossing.
Ik bedacht me dat de Opmerking een ingebouwde documenteigenschap is. Je maakt het voor ts dus helemaal af als je in de listbox nog een kolom vult met BuiltinDocumentProperties("Comments").
Overigens, ipv een listbox in een form zou een tabel op een sheet mijn voorkeur hebben, van daaruit printen. De tabel geeft de gebruiker meer mogelijkheden om te sorteren/filteren.
 
@ Rudi: Zou je hier een voorbeeld in Excel van kunnen geven, dat ik dit kan importeren? Want ik heb er is goed over nagedacht, maar ik kom er niet helemaal ut wat je bedoeld. Met een voorbeeldje zal dit een stuk duidelijker zijn. Alvast superbedankt!

@Frans: Dus wat jij bedoelt, is dat het kan, maar dan op de opmerkingen van het bestand?
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan