Skriv ut alle arbeidsbøkene i en mappe

Med makroen nedenfor kan man skrive ut alle arbeidsbøkene i en mappe. Man har større kontroll med hva som skrives ut enn om man benytter Windows Explorer.

Sub PrintAllWorkbooksInFolder(TargetFolder As String, FileFilter As String)
' skriver ut alle arbeidsbøkene i en mappe som passer til FileFilter
' eksempel: PrintAllWorkbooksInFolder "C:\FolderName", "*.xls"
' eksempel: PrintAllWorkbooksInFolder "C:\FolderName", "Bud*.xls"
Dim fn As String, sht As Variant
    Application.ScreenUpdating = False
    If Right(TargetFolder, 1) <> Application.PathSeparator Then
        TargetFolder = TargetFolder & Application.PathSeparator
    End If
    If FileFilter = "" Then FileFilter = "*.xls"
    fn = Dir(TargetFolder & FileFilter) ' det første filnavnet i mappen
    While Len(fn) > 0
        If fn <> ThisWorkbook.Name Then
            Application.StatusBar = "Skriver ut " & fn & "..."
            Workbooks.Open TargetFolder & fn
            ActiveWorkbook.PrintOut ' skriver ut alle arkene i arbeidsboken

            ' eller skriv ut hvert enkelt ark
'            For Each sht In ActiveWorkbook.Sheets
'                sht.PrintOut
'            Next sht

            ' skriv ut et bestemt ark eller diagram
'            Worksheets(1).PrintOut 
            ' skriver ut det første regnearket i arbeidsboken
'            Charts(2).PrintOut 
            ' skriver ut det andre diagrammet i arbeidsboken

            ' skriv ut alle ark av en bestemt type
'            For Each sht In ActiveWorkbook.Sheets
'                Debug.Print ActiveWorkbook.Name & " " & _
                     sht.Name & " is of type " & TypeName(sht) ' can be removed...
'                If TypeName(sht) = "Worksheet" Then
'                    sht.PrintOut ' skriv ut regneark
'                End If
'                If TypeName(sht) = "Chart" Then
'                    sht.PrintOut ' skriv ut diagrammer
'                End If
'            Next sht
            ActiveWorkbook.Close False ' lukker arbeidsboken uten å lagre endringer
        End If
        fn = Dir ' det neste filnavnet i mappen
    Wend
    Application.StatusBar = False
End Sub

Dokumentet er sist oppdatert 2000-02-04 12:35:45 Utskriftsvennlig versjon