Question

我需要做一个困难的makro。

当激活makro（通过按钮发生）时，它必须在文档中添加页眉和页脚。另外，page1 / frontpage需要与所有其他潜在页面不同的页眉和页脚。

到目前为止，我已经完成了第1页/首页的工作 - 有点。我通过录制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。但那没关系。 编辑：实际上这实现了一个奇怪的结果！让我们说我有一个页面1,2和＆amp; 3充满了文字。我按下激活宏的按钮。第1页并未收到页眉或页脚，但第2页和第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。

添加页眉和页脚宏

1 个答案: