Sett inn topp- og bunntekst

Dersom du har behov for å sette inn en standard topp- og/eller bunntekst på samtlige regnark i en arbeidsbok kan du benytte makroen nedenfor. Makroen viser også hvordan du kan få satt inn navnet på lagringsmappen til arbeidsboken i en topp- eller bunntekst.

Sub SettInnToppOgBunntekst()
' setter inn samme topp- og bunntekst på alle regnearkene i arbeidsboken
Dim ws As Worksheet
    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        Application.StatusBar = "Endrer topptekst/bunntekst i " & ws.Name
        With ws.PageSetup
            .LeftHeader = "Firmanavn"
            .CenterHeader = "Side &P av &N"
            .RightHeader = "Utskrevet &D &T"
            .LeftFooter = "Mappenavn : " & ActiveWorkbook.Path
            .CenterFooter = "Arbeidsboknavn &F"
            .RightFooter = "Arknavn &A"
        End With
    Next ws
    Set ws = Nothing
    Application.StatusBar = False
End Sub

Dersom du ikke vil endre topp-/bunntekst i alle regnearkene i arbeidsboken, kan du gjøre noe slikt:

Sub SettInnToppOgBunntekst2()
' setter inn samme topp- og bunntekst på noen regneark i arbeidsboken
Dim ws As Worksheet, i As Long
    Application.ScreenUpdating = False
    i = 0
    For Each ws In ActiveWorkbook.Worksheets
        i = i + 1
        If i >= 3 Then ' endrer bare det tredje til det siste regnearket
            Application.StatusBar = "Endrer topptekst/bunntekst i " & ws.Name
            With ws.PageSetup
                .LeftHeader = "Firmanavn"
                .CenterHeader = "Side &P av &N"
                .RightHeader = "Utskrevet &D &T"
                .LeftFooter = "Mappenavn : " & ActiveWorkbook.Path
                .CenterFooter = "Arbeidsboknavn &F"
                .RightFooter = "Arknavn &A"
            End With
        End If
    Next ws
    Set ws = Nothing
    Application.StatusBar = False
End Sub

Dokumentet er sist oppdatert 2004-06-03 11:09:05 Utskriftsvennlig versjon