Sidetal med autofilter.

Hvad med autofilter på kolonner?

Jeg er ikke helt sikker på hvad du mener?

OK - jeg har forsøgt at filtrere 150 rækker - uden at dette har givet problemer med sidetallene. Du er velkommen til at sende din fil (med sat filter) til: pb@supertekst-it.dk - så er det lettere at se problemet.

Autofilter på kolonnerne hjalp - det var bare mig som ikke kunne finde ud af at markere flere ark på samme tid og så gå i sidehovedet for at lave aut. sidetal.

Lige et spørgsmål til, kan man lave referencer til sidetallene i sidehovedet med en formel, her tænker jeg på at jeg vil lave en indholdfortegnelse?

Har ingen erfaring med det - men måske...
Hvor skal indholdsfortegnelsen opbygges?

Den ligger i samme projektmappe, men bare i et andet ark. - hvis det er det du mener?
Den skal også kun henvise til de ark, som jeg har sat sidetal på - der er nemlig også nogle ark uden sidetal og de skal ikke med.

OK - så vidt jeg ved findes der ingen funktion, der opbygger indholdsfortegnelse.
Måske kan der konstrueres "noget" via VBA.
Hvilke rækker skal indgå i indholdsfortegnelsen?

Her er VBA-kode, der skal indsættes i ARK1 i VBA-vinduet (Alt+F11) - behandler p.t. kun eet ark. Princippet er på basis af de sideskift, som Excel opretter i arket.
I koden er det celler i kolonne A, der er forsynet med FED, der anvendes i indholdsfortegnelsen - men det kan ajourføres.

Du skriver, at der skal arbejdes med flere ark - det er endnu ikke udviklet.

Men prøv dette i første omgang - koden afvikles ved F5, når markøren er i
SUB Indholdsfortegnelse:


Dim ræk, hpArr(), antalSideskift, rækNr, antalRækker
Dim indhRæk
Sub Indholdsfortegnelse()
Dim f
    ActiveWorkbook.Sheets("Ark1").Activate
   
    antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
    Cells(antalRækker, 1).Select
   
Rem Hent antallet af sideskift (vandrette)
    antalSideskift = Worksheets("Ark1").HPageBreaks.Count
    ReDim hpArr(antalSideskift + 1)

Rem Opsæt sideskift med 1. række pr.side
    For f = 1 To antalSideskift
        rækNr = Worksheets("Ark1").HPageBreaks(f).Location
        hpArr(f) = rækNr
    Next f

Rem Tildel sidenr.
    For ræk = 1 To antalRækker
        Cells(ræk, 1).Activate
        sideNr = findSideNr(ræk)
        Cells(ræk, 2) = sideNr                      'test: sidenr indsættes i række 2
    Next ræk
   
Rem opbyg indholdsfortegnelse
    If findesIndholdsfortegnelse = False Then
        Sheets.Add
        ActiveSheet.Name = "Indholdsfortegnelse"
    Else
        With Sheets("Indholdsfortegnelse")          'slet indhold, hvis findes i forvejen
            .Columns.Clear
        End With
    End If
   
    opbygIndholdsfortegnelse
   
End Sub
Private Function findSideNr(ræk)
Dim a
    For a = 1 To antalSideskift
        If ræk < hpArr(a) Then
            findSideNr = a
            Exit Function
        End If
    Next a
    findSideNr = antalSideskift + 1
End Function
Private Sub opbygIndholdsfortegnelse()
Dim ræk
    indhRæk = 1
   
    Sheets("Ark1").Activate
    For ræk = 1 To antalRækker
        If Cells(ræk, 1).Font.Bold = True Then      'Hvis cellen i kolonne A er med FED - så indgå i indh.fortegnelse
            With Sheets("Indholdsfortegnelse")
                .Cells(indhRæk, 1) = Cells(ræk, 1)
                .Cells(indhRæk, 2) = findSideNr(ræk)
                indhRæk = indhRæk + 1
            End With
        End If
    Next ræk
End Sub
Private Function findesIndholdsfortegnelse()
Dim ark
    For ark = 1 To ActiveWorkbook.Sheets.Count
        If LCase(Sheets(ark).Name) = "indholdsfortegnelse" Then
            findesIndholdsfortegnelse = True
            Exit Function
        End If
    Next ark
    findesIndholdsfortegnelse = False
End Function

Tak for koden...Den virker rigtig nok på et ark og det er da også en god idé med at den tager den fede skrift, så tak skal du have.

du får point

Så får du et svar.

Hvis du vil give points - så skal du acceptere mit svar :-)