Честно стянул код по установке колонтитулов
Скрытый текст |
---|
Option Explicit '--------------------------------------------------------------------------------------- ' Module: ЭтаКнига ' Чесно тянуто: '--------------------------------------------------------------------------------------- Sub WorkWithPages() ' Fill random data: ' Range("A2", "A100").Formula = "=RANDBETWEEN(1, 100)" Dim pgs As Pages Set pgs = ActiveSheet.PageSetup.Pages ActiveSheet.PageSetup.DifferentFirstPageHeaderFooter = True ' Look in the Immediate window for this output: запись в окно Debug.Print "The current sheet can be printed on " & _ pgs.Count & " page(s)." Dim pg As Page Set pg = pgs(1) 'установка колонтитула 1-й страницы pg.CenterHeader.Text = "This is the first page's header" Set pg = pgs(2) 'установка колонтитула 2-й страницы pg.CenterFooter.Text = "This is the second page's footer" Set pg = pgs(pgs.Count) 'установка колонтитула последней страницы pg.CenterFooter.Text = "" pg.LeftHeader.Text = "" ' Note that Excel supports only distinct headers/footers ' for the first page, so headers and footers on the second ' and other pages are combined--the last value set overwrites ' the header/footer. ' See the values in the Immediate window. ' Note that the code disregards errors that occur--attempting ' to retrieve a header/footer setting that doesn't exist raises an error: On Error Resume Next Debug.Print "First page (CenterHeader) : " & pgs(1).CenterHeader.Text Debug.Print "Second page (CenterHeader): " & pgs(2).CenterHeader.Text Debug.Print "Second page (CenterFooter): " & pgs(2).CenterFooter.Text Debug.Print "Third page (CenterFooter) : " & pgs(3).CenterFooter.Text Debug.Print "Last page (LeftHeader) : " & pgs(pgs.Count).LeftHeader.Text Debug.Print "Last page (CenterFooter) : " & pgs(pgs.Count).CenterFooter.Text ' In conclusion, use the Page class to retrieve information about headers ' and footers for specific pages. Use the PageSetup object to set the headers ' and footers, as it's clearer to set them there. End Sub |