Infoga egenskapad sidfot


Att skapa utskriftsrubriker, där varje utskrivet blad har samma rubrik, sker enkelt i XL genom att:


Att skriva ut med en och samma sidfot, som dessutom är egenskapad i ett annat arbetsblad, kräver en lösning baserad på programmering. Här demonstreras en teknik för att nå detta mål.

Utgångspunkten är att vi har två arbetsblad:

Vi skapar ett nytt utskriftsblad, där sidfoten infogas ovanför varje sidbrytning, som därefter kan skrivas ut med önskad sidfot och uppgifter.

Det som är viktigt att notera är det faktum att det inte finns en sista sidbrytning. Därför måste vi skapa en artificiell sista sidbrytning för att även i det sista utskriftsbladet få med sidfoten.

 

Sub Infoga_Egenskapad_Sidfot()

   '© 2002 Alla rättigheter XL-Dennis

   Dim wsBlad As Worksheet
   Dim rnOmrade As Range, rnCell As Range, rnKopia As Range

    With Application
      .ScreenUpdating = False
      .DisplayAlerts = False
      .Calculation = xlCalculationManual
   End With

    Set rnKopia = ActiveWorkbook.Worksheets("Sidfot").Range("B3:I5")

    'Tar bort eventuell tidigare skapat utskriftsarbetsblad
   On Error Resume Next
   ActiveWorkbook.Worksheets("XL-Dennis").Delete
   On Error GoTo 0

    'Infogar nytt utskriftsblad
   ActiveSheet.Copy After:=ActiveSheet
   ActiveSheet.Name = "XL-Dennis"

    Set rnOmrade = ActiveSheet.Range(Range("A1"), Range("A65536").End(xlUp))

    'Skapar ett temporärt arbetsbladsnamn
   ThisWorkbook.Names.Add Name:="Sista", _
         RefersTo:=ActiveSheet.Cells(rnOmrade.Rows.Count + 40, 1)

    'Tilldelar arbetsbladnamnet ett värde för att erhålla den "sista"
   'sidbrytningen
   Range("Sista").Value = 1

   Set rnOmrade = ActiveSheet.Range(Range("A1"), Range("A65536").End(xlUp))

   'Växlar visningsläge till Förhandsgranska sidbrytningar för aktivt fönster.
   ActiveWindow.View = xlPageBreakPreview

   'Loopar igenom området med data och när en sidbrytning påträffas sker
   'en kopiering av den egenskapade sidfoten ovanför sidbrytningen.
   For Each rnCell In rnOmrade
      If Rows(rnCell.Row).PageBreak <> xlNone Then
         rnCell.Offset(-3).Resize(3).EntireRow.Insert Shift:=xlDown
         rnKopia.Copy rnCell.Offset(-6)
     End If
   Next rnCell

    'Återställer visningsläget till normalt för aktivt fönster
   ActiveWindow.View = xlNormalView

   Range("Sista").ClearContents
   ThisWorkbook.Names("Sista").Delete

    With Application
      .CutCopyMode = False
      .ScreenUpdating = True
      .DisplayAlerts = True
      .Calculation = xlCalculationAutomatic
   End With
End Sub