Добавить макрос верхнего и нижнего колонтитула - PullRequest
Новая
       15

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

0 голосов
/ 05 октября 2009

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

Когда макро активирован (произойдет с помощью кнопки), он должен добавить к документу верхний и нижний колонтитулы. Кроме того, 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 получают верхний и нижний колонтитулы, закодированные выше.

1 Ответ

1 голос
/ 09 октября 2009

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

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

Это пришло от здесь и здесь .

...