0

難しいマクロを作る必要があります。

makroがアクティブ化されると（ボタンを介して発生します）、ドキュメントにヘッダーとフッターを追加する必要があります。また、page1 / 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

このコードは、ドキュメントをPDFとして保存します。しかし、それは問題ではありません。 編集：実際には、これは奇妙な結果を達成します！ページ1、2、3にテキストが入力されているとします。マクロを有効にするボタンを押します。ページ1はヘッダーもフッターも受け取りませんが、ページ2と3は上記でコード化されたヘッダーとフッターを受け取ります。

4

1 に答える 1

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

これはこことここから来ました。

于 2009-10-09T07:05:11.590 に答える