Udskrift af ark

Automatik i denne sammenhæng kan kun opnås ved hjælp af en makro, så vidt jeg ved.

Der findes en hændelse (Event), som hedder Workbook_BeforePrint, der trigges, når noget udskrives. I denne event kan man så skrive en makro, der løber alle ark igennem og justerer udskriftsområderne i forhold til den sidste celle med synligt indhold.

Jeg har tilpasset en VBA-kode, som blev foreslået af Google Gemini:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim ws As Worksheet
    Dim sidsteRække As Long
    Dim sidsteKolonne As Long
    Dim omraade As String
    Dim r As Long
    Dim c As Long

    ' Loop igennem alle ark i den aktive projektmappe
    For Each ws In ThisWorkbook.Worksheets
       
        ' Find den sidste række og kolonne med indhold
        On Error Resume Next
        For r = ws.Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
            If WorksheetFunction.CountBlank(ws.Rows(r)) < ws.Columns.Count Then
                sidsteRække = r
                Exit For
            End If
        Next r
        For c = ws.Cells.SpecialCells(xlCellTypeLastCell).Column To 1 Step -1
            If WorksheetFunction.CountBlank(ws.Columns(c)) < ws.Rows.Count Then
                sidsteKolonne = c
                Exit For
            End If
        Next c
        On Error GoTo 0

        ' Hvis arket ikke er tomt, sæt udskriftsområdet
        If sidsteRække > 0 And sidsteKolonne > 0 Then
            omraade = ws.Range(ws.Cells(1, 1), ws.Cells(sidsteRække, sidsteKolonne)).Address
            ws.PageSetup.PrintArea = omraade
        Else
            ' Hvis arket er tomt, fjern eventuelt eksisterende udskriftsområde
            ws.PageSetup.PrintArea = ""
        End If
       
        ' Nulstil variabler til næste ark
        sidsteRække = 0
        sidsteKolonne = 0
    Next ws

    MsgBox "Udskriftsområdet er nu opdateret på alle ark!", vbInformation, "Færdig"
End Sub

Hej MaxZpaD
Din kode virker perfekt, men når jeg skrivebeskytter arkene, virker koden ikke.
Vil du indsætte en tillæg til koden der fjerner arkbeskyttelse, når koden er kørt arkbeskytte igen

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim ws As Worksheet
    Dim sidsteRække As Long
    Dim sidsteKolonne As Long
    Dim omraade As String
    Dim r As Long
    Dim c As Long
    ' Loop igennem alle ark i den aktive projektmappe
    For Each ws In ThisWorkbook.Worksheets
          With ws
            On Error Resume Next
                If .ProtectContents Then .Unprotect
                ' Find den sidste række og kolonne med indhold
                For r = .Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
                    If WorksheetFunction.CountBlank(.Rows(r)) < .Columns.Count Then
                        sidsteRække = r
                        Exit For
                    End If
                Next r
                For c = .Cells.SpecialCells(xlCellTypeLastCell).Column To 1 Step -1
                    If WorksheetFunction.CountBlank(.Columns(c)) < .Rows.Count Then
                        sidsteKolonne = c
                        Exit For
                    End If
                Next c
               
       
                ' Hvis arket ikke er tomt, sæt udskriftsområdet
                If sidsteRække > 0 And sidsteKolonne > 0 Then
                    omraade = .Range(.Cells(1, 1), .Cells(sidsteRække, sidsteKolonne)).Address
                    .PageSetup.PrintArea = omraade
                Else
                    ' Hvis arket er tomt, fjern eventuelt eksisterende udskriftsområde
                    .PageSetup.PrintArea = ""
                End If
             
                ' Nulstil variabler til næste ark
                sidsteRække = 0
                sidsteKolonne = 0
                If Not .ProtectContents Then .Protect
            On Error GoTo 0
        End With
    Next ws
    MsgBox "Udskriftsområdet er nu opdateret på alle ark!", vbInformation, "Færdig"
End Sub

Virker perfekt, 1000 tak for hjælpen :-)