Sisukorra makro - Exceli näpunäited

Täname Mattit, kes saatis selle nädala Exceli küsimuse:

Mul on suur ja kasvav Exceli töövihik (palju lehti). Olen printimise ajal lisanud jalusesse leheküljenumbrid, kuid koosolekul liikudes on järjest raskem navigeerida. Kas Exceli töölehtede nimede põhjal saab sisukorra printida, et saaksin mina ja töötajad kiiresti lehele #xx pöörduda?

See on suurepärane idee. Esimene lihtne ettepanek on lisada lehe nimi väljatrüki jalusesse. Kui klõpsate dialoogis Lehe häälestus / Päisejalus nupul „Kohandatud jalus”, on 7 ikooni. Parempoolne ikoon näeb välja nagu kolme kaardiga registrikaart. Klõpsates kastis Parem: ja vajutades sellele ikoonile, prinditakse lehe nimi igale lehele. Juba see võib aidata aruandes liikumisel.

MrExcelile meeldib idee sisukorra loomiseks makro olemasolu. Peamine probleem on see, et Excel ei arvuta, kui palju prinditud lehti töölehel on, enne kui teete prindi eelvaate. Niisiis, makro annab kasutajale teada, et ta näeb prindi eelvaadet, ja palub neil selle sulgemiseks klõpsata sulgemisnuppu.

Makro viib läbi töövihiku iga lehe. Praeguses olekus kogub see teavet iga töölehe nimest. Lisasin ka kaks muud rida, mida kommenteeritakse. Kui soovite kirjelduse saada pigem vasakust päisest või lahtris A1 olevast pealkirjast, on ka mõlemal neist teha näidis read. Kommenteerige lihtsalt see, mida soovite kasutada.

Makro arvutab mitu lehte, lisades ühe horisontaalsete lehepauside arvule (HPageBreaks.count). See lisab ühe vertikaalsete lehepauside arvule (VPageBreaks.Count). Sellel töölehel olevate lehtede arvu arvutamiseks korrutatakse need kaks arvu kokku. Kui mõnel lojaalsel lugejal on selleks parem viis, palun andke mulle sellest teada. Praegune lehelõikude loendamise meetod on kuradima aeglane. Ma ei suutnud leida omadust, mis ütleks mulle, kui palju trükitud lehti on, kuid arvate, et Excelis oleks see üks.

Viimane nipp oli lehevahemikku sisenemine. Kui leht asus lehtedel "3 - 4", käsitleb Excel seda kuupäevana ja sisestab 4. märtsi. Seadistades lahtrivormingu tähemärgiga "@" tekstiks, sisestatakse lehed õigesti.

Siin on makro:

Sub CreateTableOfContents() ' Copyright 1999.com ' Determine if there is already a Table of Contents TOCFound = False For Each s In Worksheets If s.Name = "Table of Contents" Then TOCFound = True Exit For End If Next s If Not TOCFound Then Sheets.Add Before:=Worksheets(1) ActiveSheet.Name = "Table of Contents" End If ' Set up the table of contents page TOCRow = 7 PageCount = 0 Sheets("Table of Contents").Select Range("A2").Value = "Table of Contents" Range("A6").CurrentRegion.Clear Range("A6").Value = "Subject" Range("A6").ColumnWidth = 36 Range("B6").Value = "Page(s)" Range("B6").ColumnWidth = 12 ' Do a print preview on all sheets so Excel calcs page breaks ' The user must manually close the PrintPreview window Worksheets.Select Msg = "Excel needs to do a print preview to calculate the number of pages. " Msg = Msg & "Please dismiss the print preview by clicking close." Msgbox Msg ActiveWindow.SelectedSheets.PrintPreview ' Loop through each sheet, collecting TOC information For Each s In Worksheets s.Select ' Use any one of the following 3 lines ThisName = ActiveSheet.Name 'ThisName = Range("A1").Value 'ThisName = ActiveSheet.PageSetup.LeftHeader HPages = ActiveSheet.HPageBreaks.Count + 1 VPages = ActiveSheet.VPageBreaks.Count + 1 ThisPages = HPages * VPages ' Enter info about this sheet on TOC Sheets("Table of Contents").Select Range("A" & TOCRow).Value = ThisName Range("B" & TOCRow).NumberFormat = "@" If ThisPages = 1 Then Range("B" & TOCRow).Value = PageCount + 1 & " " Else Range("B" & TOCRow).Value = PageCount + 1 & " - " & PageCount + ThisPages End If PageCount = PageCount + ThisPages TOCRow = TOCRow + 1 Next s End Sub

Allpool on samaväärne makro, mida on uuendatud mitme uue makrotehnikaga.

Sub CreateTableOfContents() ' Copyright 2002.com ' Determine if there is already a Table of Contents ' Assume it is there, and if it is not, it will raise an error ' if the Err system variable is> 0, you know the sheet is not there Dim WST As Worksheet On Error Resume Next Set WST = Worksheets("Table of Contents") If Not Err = 0 Then ' The Table of contents doesn't exist. Add it Set WST = Worksheets.Add(Before:=Worksheets(1)) WST.Name = "TOC" End If On Error GoTo 0 ' Set up the table of contents page WST.(A2) = "Table of Contents" With WST.(A6) .CurrentRegion.Clear .Value = "Subject" End With WST.(B6) = "Page(s)" WST.Range("A1:B1").ColumnWidth = Array(36, 12) TOCRow = 7 PageCount = 0 ' Do a print preview on all sheets so Excel calcs page breaks ' The user must manually close the PrintPreview window Msg = "Excel needs to do a print preview to calculate the number of pages. " Msg = Msg & "Please dismiss the print preview by clicking close." MsgBox Msg ActiveWindow.SelectedSheets.PrintPreview ' Loop through each sheet, collecting TOC information ' Loop through each sheet, collecting TOC information For Each S In Worksheets If S.Visible = -1 Then S.Select ' Use any one of the following 3 lines ThisName = ActiveSheet.Name 'ThisName = Range("A1").Value 'ThisName = ActiveSheet.PageSetup.LeftHeader HPages = ActiveSheet.HPageBreaks.Count + 1 VPages = ActiveSheet.VPageBreaks.Count + 1 ThisPages = HPages * VPages ' Enter info about this sheet on TOC Sheets("TOC").Select Range("A" & TOCRow).Value = ThisName Range("B" & TOCRow).NumberFormat = "@" If ThisPages = 1 Then Range("B" & TOCRow).Value = PageCount + 1 & " " Else Range("B" & TOCRow).Value = PageCount + 1 & " - " & PageCount + ThisPages End If PageCount = PageCount + ThisPages TOCRow = TOCRow + 1 End If Next S End Sub

Lühike kokkuvõte uutest makrode uutest makrotehnikast:

  • Lehte tuleb harva valida
  • Selle asemel, et töövihikus igat lehte otsida, otsides lehte nimega Sisukord, eeldab teine ​​makro lihtsalt, et see on olemas, ja kontrollib muutuja Err olekut. Kui Err on midagi muud kui 0, teame, et lehte pole olemas ja see tuleb lisada.
  • WST on objekti muutuja ja määratletakse sisukorra töölehena. Seega kõik viited töölehtedele ("Sisukord"). saab asendada WST-ga.
  • Lahtrite (rida, veerg) konstruktsioon on efektiivsem kui Range ("A" ja TOCRow) kluge. Kuna Cells () eeldab arvulisi parameetreid, saab vahemikust ("A" ja TOCRow) lahtrid (TOCRow, 1)
  • Nurksulgudes kasutatakse vahemikku ("A1") viidates lühike viis.

Huvitavad Artiklid...