English 中文(简体)
添加头盔和脚步
原标题:Add header and footer macro
  • 时间:2009-10-05 13:11:23
  •  标签:

我需要做一个困难的 m子。

When the makro has been activated (will happen via a button), it has to add a header and a footer to the document. Also page1/frontpage needs a different header and footer than all the other potential pages.

So far, I have accomplished making page1/frontpage to work - somewhat. I did this by recording a makro, where I d enable headers and footers, write the needed data and then stop recording. Afterwards I edited the coding so it would fit a little better. Mostly it was junk-code cleanup.

不过,如果我使用几页的话,它就没有工作。

我如何能够完成这一安排?

如果有人有兴趣的话,我可以向你们提供我目前的法典:

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

The code also saves the dokument as a PDF. But that doesn t matter. EDIT: Actually this accomplishes an odd result! Let us say that I have a page1, 2 & 3 filled with text. I press the button that activates the macro. Page 1 recieves no header nor footer, but page 2 & 3 recieves the header and footer coded above.

最佳回答

为此:

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

问题回答

暂无回答




相关问题
热门标签