添加頁眉和頁腳宏

Question

我需要創建一個困難的makro。

當makro激活（將通過按鈕發生）時，它必須向文檔添加頁眉和頁腳。 第1頁/首頁需要與所有其他潛在頁面不同的頁眉和頁腳。

到目前爲止，我已經完成了使page1/frontpage工作 - 有點。 我通過錄制一個makro來做到這一點，我可以在其中啓用頁眉和頁腳，寫入所需的數據，然後停止錄製。之後我編輯了編碼，以便它更適合一點。主要是垃圾代碼清理。

但是，如果我使用多個頁面，它不起作用。

我該如何完成此設置？

我可以爲你提供我當前的代碼，如果有人有興趣：

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 

代碼也節省了庫門爲PDF。但那並不重要。 編輯：其實這實現了一個奇怪的結果！ 讓我們說，我有一個page1,2個填充文本。 我按下了激活宏的按鈕。 Page 1接收到頁眉和頁腳，但頁面2接收到上面編碼的頁眉和頁腳。

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。