Indholdsfortegnelse i Projektmappe med flere ark

Hvis din udskrift er lagret i et ark - så kan det lade sig gøre.

Jeg er ikke sikker på, at jeg forstår: 'Lagret i et ark'

Hvis ark, der skal udskrives blev samlet i et ark til udskrift - kunne de enkelte arks placering på siderne beregnes.

I modsat fald skal der udføres en beregning på de enkelte ark for at finde sidenr. på den samlede udskrift.

Som jeg ser det, er det beregningen af sidenr. på grundlag af de valgte ark, som så bliver det store problem (Idet udskiften ikke samles i et ark)

Bliver alle rækker udskrevet fra de enkelte ark - eller kan de linier, der udskrives identificeres?

Det er forholdsvis store ark, hvor de rækker som ikke skal vises - skjules via en skjul-makro. Så ja - rækkerne er identificeret ved at være sand eller falsk i kolonne A.

Hvormange linier udskrives der pr. side?

Forslag:
Dim arkTilPrint() As Variant
Const indhfort_Ark = "Indholdsfortegnelse"          'evt. justeres"
Const indhfort_Startræk = 3                        'Startrække- under overskrifter
Const antalRækPrSide = 56                          'justeres
Dim indhTabel(), arkNr
Sub opbygIndholdsfortegnelse()                      'evt. makro_knap skal aktivere denne "Sub"
Dim ark, antalNettolinier
Rem Opsæt arknavne, der skal udskrives
    arkTilPrint = Array("Ark1", "Ark2", "Ark3", "Ark5")            'justeres
   
Rem opsæt tabel til indholdsfortegnelse
    ReDim indhTabel(UBound(arkTilPrint), 2)
    arkNr = 0
   
Rem undersøg de enkelte ark, om de skal udskrives
    For Each ark In ActiveWorkbook.Sheets
        If skalArkUdskrives(ark.Name) = True Then
            antalNettolinier = optælNettoLinier(ark.Name)
            indhTabel(arkNr, 0) = ark.Name
            indhTabel(arkNr, 1) = antalNettolinier
            arkNr = arkNr + 1
        End If
    Next
   
    Indholdsfortegnelse
End Sub
Private Function skalArkUdskrives(arkNavn)
antal = UBound(arkTilPrint)

    For f = 0 To UBound(arkTilPrint)
        If arkNavn = arkTilPrint(f) Then
            skalArkUdskrives = True
            Exit Function
        End If
    Next f
    skalArkUdskrives = False
End Function
Private Function optælNettoLinier(ark)              'optæller IKKE-skjulte linier
Dim netto, bruttolinier
    netto = 0
    With ActiveWorkbook.Sheets(ark)
        .Activate
        bruttolinier = ActiveCell.SpecialCells(xlLastCell).Row
           
        For r = 1 To bruttolinier
            If .Rows(r).EntireRow.Hidden = False Then
                netto = netto + 1
            End If
        Next r
    End With
    optælNettoLinier = netto
End Function
Private Sub Indholdsfortegnelse()                  'indsætter indholdsfortegnelse på relevante ark
Dim linier, sideNr
    linier = 0
   
    ActiveWorkbook.Sheets(indhfort_Ark).Activate
   
    For i = 0 To UBound(indhTabel)
        ark = indhTabel(i, 0)
       
        If i = 0 Then
            sideNr = 2
        Else
            s = linier \ antalRækPrSide
            If linier Mod antalRækPrSide <> 0 Then
                s = s + 1
            End If
            sideNr = sideNr + s
        End If
        linier = indhTabel(i, 1)
       
        Cells(indhfort_Startræk + i, 1) = ark
        Cells(indhfort_Startræk + i, 2) = sideNr
    Next i
End Sub

Jeg vil i løbet af dagen undersøge om jeg kan bruge ovennævnte. Det ser umiddelbart godt ud. Indtil tusind tak og jeg vender tilbage

OK

Hej supertekst. Har været syg. Vender først tilbage i løbet af nogle dage.

ok..

???

Supertekst>
Det er faktisk bare i orden. Fik det med nogle små tilpasninger til at fungere godt. Beklager den sene svar. Min kommentar af 30.6. var rimelig avorlig. På banen igen.
Læg et svar og på forhånd tak for tålmodighed.

Selv tak og du får et svar & ønske om god bedring