Obsah Makro - tipy pro Excel

Děkujeme Mattovi, který poslal tento týden excelovou otázku:

Mám velký a rostoucí sešit aplikace Excel (spousta listů). Při tisku jsem do zápatí zahrnul čísla stránek, ale navigace na schůzce je stále obtížnější. Existuje způsob, jak vytisknout obsah založený na názvech listů aplikace Excel, abych se já a zaměstnanci mohli rychle obrátit na stránku #xx?

To je skvělý nápad. Prvním jednoduchým návrhem je zahrnout název listu do zápatí vašeho výtisku. Když kliknete na „Vlastní zápatí“ v dialogovém okně Vzhled stránky / Záhlaví, zobrazí se 7 ikon. Ikona zcela vpravo vypadá jako indexová karta se třemi kartami. Kliknutím do pole V pravé části: a klepnutím na tuto ikonu způsobíte, že se název listu vytiskne na každý list. To samo o sobě může pomoci při procházení zprávou.

MrExcel má rád myšlenku mít makro k vytvoření obsahu. Hlavním problémem je, že Excel nevypočítává, kolik vytištěných stránek je v listu, dokud neprovedete náhled tisku. Makro tedy umožňuje uživateli vědět, že se chystá zobrazit náhled tisku, a žádá je, aby jej zrušili kliknutím na tlačítko zavřít.

Makro prochází každý list v sešitu. V aktuálním stavu shromažďuje informace z názvu každého listu. Zahrnul jsem také dva další řádky, které jsou komentovány. Pokud byste raději dostali popis z levého záhlaví nebo z nadpisu v buňce A1, existují ukázkové řádky, které také můžete udělat. Stačí odkomentovat ten, který chcete použít.

Makro vypočítá, kolik stránek přidáním jedné k počtu vodorovných konců stránek (HPageBreaks.count). Přidává jeden k počtu svislých konců stránek (VPageBreaks.Count). Násobí tato dvě čísla dohromady a vypočítá počet stránek v tomto listu. Pokud mají věrní čtenáři lepší způsob, jak to udělat, dejte mi prosím vědět. Současná metoda počítání konců stránek je ďábelsky pomalá. Zdálo se mi, že nenajdu vlastnost, která by mi řekla, kolik tištěných stránek je, ale mysleli byste si, že Excel bude jednu obsahovat.

Posledním trikem bylo zadání rozsahu stránek. Pokud byl list na stránkách „3–4“, Excel by to považoval za datum a zadal by 4. března. Nastavením formátu buňky na text se znakem „@“ se stránky zadají správně.

Tady je 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

Níže je ekvivalentní makro aktualizované několika novými technikami makra.

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

Stručné shrnutí nových technik makra v novějším makru:

  • Je zřídka nutné vybrat list
  • Spíše než procházet jednotlivé listy v sešitu a hledat list s názvem Obsah, druhé makro jednoduše předpokládá, že tam je, a zkontroluje stav proměnné Err. Pokud Err je něco jiného než 0, víme, že list neexistuje a je třeba ho přidat.
  • WST je proměnná objektu a je definována jako pracovní list s obsahem. Tedy jakýkoli odkaz na pracovní listy („obsah“). lze nahradit WST.
  • Konstrukce Buňky (řádek, sloupec) je efektivnější než kluge z Range ("A" & TOCRow). Protože Cells () očekává číselné parametry, Range ("A" & TOCRow) se stane buňkami (TOCRow, 1)
  • Hranaté závorky se používají jako zkratkový způsob odkazu na Range ("A1").

Zajímavé články...