views:

574

answers:

1

Hi.

I need to make a difficult makro.

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.

It doesn't work though, if I use several pages.

How can I accomplish this setup?

I can provide you my current code, if anyone is interested:

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.

+1  A: 

Try this:

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

This came from here and here.

kgiannakakis
Hi. I have read the articles a few tmies,but I still have problems.Is there any way I can use selection instead of range?I have huge troubles with range, since I want to add some text, move somewhere else, perhaps change font, set bold etc. and then type a new text etc.
CasperT
I believe that the easiest way to do what you want is to use the FormattedText property of the Range object. For example select a paragraph in your document and do .Range.FormattedText = Selection.FormattedText
kgiannakakis