Добавить макрос верхнего колонтитула

Question

Мне нужно сделать сложный макро.

Когда макро был активирован (произойдет через кнопку), он должен добавить заголовок и нижний колонтитул в документ. Также страница1/frontpage нуждается в другом верхнем и нижнем колонтитулах, чем все другие потенциальные страницы.

До сих пор я сделал работу page1/frontpage - несколько. Я сделал это, записав макро, где я бы включил верхние и нижние колонтитулы, записал необходимые данные и остановил запись. После этого я отредактировал кодировку, чтобы она немного поправилась. В основном это была обработка нежелательных кодов.

Это не работает, если я использую несколько страниц.

Как я могу выполнить эту настройку?

Я могу предоставить вам мой текущий код, если кому-то интересно:

Sub PDFtest2() 
' 
' PDFtest2 Macro 
' 
' 
    Dim FileName As String 
    Dim minPDFSti As String 
    Dim aryFolders 
    Dim i As Long 
    Dim version As String 
    Dim sFolder As String 

    'Skaf dokument titel 
    FileName = ActiveDocument.Name 'e.g document1.doc 
    aryFolders = Split(FileName, ".") 'split ved .doc da vi skal bruge pdf extension 
    FileName = aryFolders(LBound(aryFolders)) 'document1 

    'Lav en document-1 hvis document allerede eksistere. Putter også .pdf på som extension 
    If Dir(minPDFSti + FileName + ".pdf") <> "" Then 
     aryFolders = Split(FileName, "-") 
     version = aryFolders(UBound(aryFolders)) 
     If version <> "" Then 
      FileName = FileName + "-" + version + "-1.pdf" 
     Else 
      FileName = FileName + "-1.pdf" 
     End If 
    Else 
     FileName = FileName + ".pdf" 
    End If 

    'Vores PDF sti 
    minPDFSti = "c:\PDF\" 


    If Dir(minPDFSti, vbDirectory) = "" Then 
     'If MsgBox("PDF Mappen eksistere ikke, lav en?", _ 
     'vbYesNo, "PDF Mappe") = vbYes Then 
      aryFolders = Split(minPDFSti, "\") 
      sFolder = aryFolders(LBound(aryFolders)) 
      For i = LBound(aryFolders) + 1 To UBound(aryFolders) 
       sFolder = sFolder & "\" & aryFolders(i) 
       If Dir(sFolder, vbDirectory) = "" Then MkDir sFolder 
      Next i 
     'End If 
    End If 

    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then 
     ActiveWindow.Panes(2).Close 
    End If 
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _ 
     ActivePane.View.Type = wdOutlineView Then 
     ActiveWindow.ActivePane.View.Type = wdPrintView 
    End If 
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter 
    Selection.TypeText Text:="Advokatfirmaet" 
    Selection.TypeParagraph 
    Selection.TypeText Text:="Beck & Partnere" 
    Selection.MoveLeft Unit:=wdCharacter, Count:=15, Extend:=wdExtend 
    Selection.Font.Size = 12 
    Selection.Font.Size = 13 
    Selection.MoveRight Unit:=wdCharacter, Count:=1 
    Selection.MoveLeft Unit:=wdCharacter, Count:=16, Extend:=wdExtend 
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend 
    Selection.Font.Bold = wdToggle 
    Selection.MoveRight Unit:=wdCharacter, Count:=1 
    Selection.MoveLeft Unit:=wdCharacter, Count:=15, Extend:=wdExtend 
    Selection.Font.Bold = wdToggle 
    Selection.MoveRight Unit:=wdCharacter, Count:=1 
    Selection.MoveDown Unit:=wdLine, Count:=1 
    Selection.TypeText Text:="Advokataktieselskab" 
    Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(4.5), _ 
     Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces 
    Selection.TypeText Text:=vbTab & "Damhaven 5" 
    Selection.ParagraphFormat.TabStops(CentimetersToPoints(7.96)).Position = _ 
     CentimetersToPoints(7.96) 
    Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(8.25) _ 
     , Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces 
    Selection.ParagraphFormat.TabStops(CentimetersToPoints(7.96)).Position = _ 
     CentimetersToPoints(8.25) 
    Selection.TypeText Text:=vbTab & "Giro 193 5100" 
    Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(12.25 _ 
     ), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces 
    Selection.TypeText Text:=vbTab & "Tel." & vbTab & "+45 75 72 41 00" 
    Selection.TypeParagraph 
    Selection.TypeText Text:="CVR 25 79 71 24" & vbTab & "DK-7100 Vejle" & _ 
     vbTab 
    Selection.ParagraphFormat.TabStops(CentimetersToPoints(8.25)).Position = _ 
     CentimetersToPoints(9) 
    Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(8.25) _ 
     , Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces 
    Selection.TypeText Text:="www.becklaw.dk" & vbTab & "Fax" & vbTab & _ 
     "+45 75 72 41 00" 
    Selection.MoveUp Unit:=wdLine, Count:=1 
    Selection.MoveLeft Unit:=wdCharacter, Count:=26 
    Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(8.25) _ 
     , Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces 
    Selection.ParagraphFormat.TabStops(CentimetersToPoints(8.25)).Position = _ 
     CentimetersToPoints(9) 
    Selection.ParagraphFormat.TabStops(CentimetersToPoints(9)).Position = _ 
     CentimetersToPoints(8.25) 

    ChangeFileOpenDirectory minPDFSti 'Sikre dig at stien eksistere 
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _ 
     minPDFSti + FileName, ExportFormat:= _ 
     wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _ 
     wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _ 
     Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _ 
     CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _ 
     BitmapMissingFonts:=True, UseISO19005_1:=False 
    Selection.WholeStory 
    Selection.TypeBackspace 
    Selection.MoveUp Unit:=wdLine, Count:=1 
    Selection.WholeStory 
    Selection.TypeBackspace 
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 
End Sub 

Код также сохраняет Dokument как PDF. Но это не имеет значения. РЕДАКТИРОВАТЬ: На самом деле это нечетный результат! Скажем, у меня есть страница 1, 2 & 3 заполненная текстом. Я нажимаю кнопку, которая активирует макрос. Страница 1 не получает ни заголовка, ни нижнего колонтитула, но страница 2 & 3 получает верхний и нижний колонтитулы, закодированные выше.

Answer 1

Попробуйте это:

Sub HeaderFooterObject() 
    Dim MyText As String 
    MyHeaderText = "Header text" 
    MyFooterText = "Footer text" 
    MyHeaderTextFirstPage = "First Page" 
    MyFooterTextFirstPage = "Footer text First Page" 
    With ActiveDocument.Sections(1) 
    .PageSetup.DifferentFirstPageHeaderFooter = True 
    .Headers(wdHeaderFooterPrimary).Range.Text = MyHeaderText 
    .Footers(wdHeaderFooterPrimary).Range.Text = MyFooterText 

    .Headers(wdHeaderFooterFirstPage).Range.Text = MyHeaderTextFirstPage 
    .Footers(wdHeaderFooterFirstPage).Range.Text = MyFooterTextFirstPage 
    End With 
End Sub 

Это произошло из here и here.