Insert text into first page header only. 1

[JohnnyLong]

I have a Word 2000 macro that inserts text and logos into the header and footer of word docs. How do I change it so the text is only inserted into the first page header?

Here is the code:

Sub FormatCVTemplate()

Dim tmpFileName
Dim Template
Dim OriginalFileName
Dim OriginalPath
Dim FontSize
Dim FontName

Const ROOT_DRIVE = "C:\"

OriginalFileName = ActiveDocument.Name
OriginalPath = ActiveDocument.Path
tmpFileName = ROOT_DRIVE & "Macro\tmpDoc.doc"

' Save CV document
ActiveDocument.SaveAs (tmpFileName)

' Open Template Document
Documents.Open FileName:=ROOT_DRIVE & "Macro\FormatCVTemplate.doc"
Template = ActiveDocument.Name

If Documents(Template).ActiveWindow.View.SplitSpecial <> wdPaneNone Then
Documents(Template).ActiveWindow.Panes(2).Close
End If
If Documents(Template).ActiveWindow.ActivePane.View.Type = wdNormalView Or _
Documents(Template).ActiveWindow.ActivePane.View.Type = wdOutlineView Then
Documents(Template).ActiveWindow.ActivePane.View.Type = wdPrintView
End If

' Copy header from template
Documents(Template).ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.WholeStory
FontSize = Selection.Font.Size
FontName = Selection.Font.Name
Selection.Copy
Documents(Template).ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

' Open tmpFileName document
Documents(tmpFileName).Activate
If Documents(tmpFileName).ActiveWindow.View.SplitSpecial <> wdPaneNone Then
Documents(tmpFileName).ActiveWindow.Panes(2).Close
End If
If Documents(tmpFileName).ActiveWindow.ActivePane.View.Type = wdNormalView Or _
Documents(tmpFileName).ActiveWindow.ActivePane.View.Type = wdOutlineView Then
Documents(tmpFileName).ActiveWindow.ActivePane.View.Type = wdPrintView
End If

' Paste template header into tmpFileName
Documents(tmpFileName).ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Paste
Selection.TypeBackspace
Selection.WholeStory
Selection.Font.Size = FontSize
Selection.Font.Name = FontName
Documents(tmpFileName).ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

' Open template document
Documents(Template).Activate
If Documents(Template).ActiveWindow.View.SplitSpecial <> wdPaneNone Then
Documents(Template).ActiveWindow.Panes(2).Close
End If
If Documents(Template).ActiveWindow.ActivePane.View.Type = wdNormalView Or _
Documents(Template).ActiveWindow.ActivePane.View.Type = wdOutlineView Then
Documents(Template).ActivePane.View.Type = wdPrintView
End If

' Copy footer from template
Documents(Template).ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If Selection.HeaderFooter.IsHeader = True Then
Documents(Template).ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
Documents(Template).ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If
Selection.WholeStory
Selection.Copy
FontSize = Selection.Font.Size
FontName = Selection.Font.Name
Documents(Template).ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

' Paste template footer into formatted tmpFileName
Documents(tmpFileName).Activate
If Documents(tmpFileName).ActiveWindow.View.SplitSpecial <> wdPaneNone Then
Documents(tmpFileName).ActiveWindow.Panes(2).Close
End If
If Documents(tmpFileName).ActiveWindow.ActivePane.View.Type = wdNormalView Or _
Documents(tmpFileName).ActiveWindow.ActivePane.View.Type = wdOutlineView Then
Documents(tmpFileName).ActiveWindow.ActivePane.View.Type = wdPrintView
End If
Documents(tmpFileName).ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If Selection.HeaderFooter.IsHeader = True Then
Documents(tmpFileName).ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
Documents(tmpFileName).ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If
Selection.Paste
Selection.TypeBackspace
Selection.WholeStory
Selection.Font.Size = FontSize
Selection.Font.Name = FontName
Documents(tmpFileName).ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

' Open template document
Documents(Template).Activate

' Copy any text from the template
Selection.WholeStory
Selection.Copy
' Close template
Documents(Template).Close

' Paste text from template into tmpFileName
Selection.Paste

' Save formatted CV using original filename
ActiveDocument.SaveAs (OriginalPath + "\" + OriginalFileName)

' Delete tmpFileName file
Set fs = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
fs.DeleteFile (tmpFileName)

End Sub

Thanks in advance,

John

 

[CBasicAsslember]

ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True

 

[fumei]

May I suggest some things?

1. Declare your variables as specific data types.

Dim tmpFileName
Dim Template
Dim OriginalFileName

will make all these Variants. You are not using them as Variants. You are using them as strings. It is better to declare them AS strings.

2. Use one variable when one variable will do.

Dim OriginalFileName
Dim Original Path

OriginalFileName = ActiveDocument.Name
OriginalPath = ActiveDocument.Path

would be better done as:

Dim OriginalFilePathName As String
OriginalFilePathName = ActiveDocument.FullName

There is no need for the separate variables.

3. While not wrong, I am not sure why you declare and use the Constant ROOT_DRIVE. It certainly is not needed. What is wrong with using:

tmpFileName =  "C:\Macro\tmpDoc.doc"

In fact, it is less typing.

4. It is much more efficient to use objects. You have all this opening of files, copying of header and footer, going to the other file and pasting, pasting. Openign of Views etc etc etc.

None of that is required.

You open the "template" file - which BTW it is NOT, a template that is...see next point - open Header view, copy the contents, go back to the other file, paste the header, go back to the "template" file, open Footer view, copy the contents, go back to the other file, paste the footer.

All of this is done with Views, so the user interface will show all this stuff going on. You can, of course, turn off ScreenRefresh...but resources are being used for all that copying and pasting. Here is what you can do.

[ol][li] declare HeaderFooter objects for the original file, and the new file[/li]
[li] open the "template" file, and set the objects to those headers and footers[/li]
[li] set objects for the new file headers and footers.[/li]
[li] set the new file header objects to equal the original file header[/li][/ol]

Done. Here is code that does essentially what you are doing, but does not use any copy and paste. Note, you can can also make a Content object for the entire docoument. Again, no need to copy and paste.

Sub CopyStuff()
    Dim oOriginalHeader As Word.HeaderFooter
    Dim oOriginalFooter As Word.HeaderFooter
    Dim oNewHeader As Word.HeaderFooter
    Dim oNewFooter As Word.HeaderFooter
    Dim oContent
    Dim TempDoc As Document
    Dim tmpFileName As String
    Dim OriginalFilePathName As String

    OriginalFilePathName = ActiveDocument.FullName
    tmpFileName = "C:\Test\tmpDoc.doc"

[COLOR=red]' save as different name
' set doc object[/color red]
    ActiveDocument.SaveAs (tmpFileName)
    Set TempDoc = ActiveDocument
[COLOR=red]' Open Template Document
' although this is NOT a template[/color red]
    Documents.Open FileName:="C:\Test\FormatCVTemplate.doc"
[COLOR=red]' set header/footer objects
' set Content object[/color red]
    Set oOriginalHeader = _
     ActiveDocument.Sections(1).Headers(1)
    Set oOriginalFooter = _
     ActiveDocument.Sections(1).Footers(1)
    Set oContent = ActiveDocument.Content
[COLOR=red]' make sure First Page set[/color red]
    TempDoc.PageSetup.DifferentFirstPageHeaderFooter = True
[COLOR=red]' set tempdoc header/footer objects
' and make objects match[/color red]
    Set oNewHeader = TempDoc.Sections(1).Headers(wdHeaderFooterFirstPage)
    Set oNewFooter = TempDoc.Sections(1).Footers(wdHeaderFooterFirstPage)
    oNewHeader.Range = oOriginalHeader.Range
    oNewFooter.Range = oOriginalFooter.Range
[COLOR=red]' match the content objects[/color red]
    TempDoc.Content = oContent
[COLOR=red]' save doc[/color red]
    TempDoc.SaveAs FileName:=OriginalFilePathName
    ActiveDocument.Close wdDoNotSaveChanges
End Sub

NOTE: this is set up for the original "template" document NOT having Page Setup with header/footer Different FirstPage. If it IS set up that way, this would ave to modified.

5. Lastly, if I understand this corectly you are:[ol][li]saving the current file as a temp file[/li][li]opening another file with headers/footers you want[/li][li]copying those headers/footers to the new file[/li][li]copying the content of the "template" to the new file[/li][/ol]

This is where I get to the quotation marks around template. If the file you open is a .DOC file, it is NOT a template.

A template file is a .DOT file, and it is used to do exactly what you seem to be doing.

If you used a proper .DOT (template) file, you could simply go File > New, select the template, press OK, and you would have a new document that is a clone of the template. The headers would match, the footers would match, the text content would match, the format would match. Templates make a clone of themselves.

Since you are copying the headers, footers, and content...this seems exactly what using a real template file would do for you.

Hope this helps.

Gerry
My paintings and sculpture

 

[JohnnyLong]

Thank you CBasicAsslember that works.

Gerry, thanks very much for your comprehensive reply, exactly why Tek-Tips is the best forum to pick brains! I have pasted your code into a new macro but I haven't got it working yet, but I will keep trying as it looks much more efficient. Basically, all I'm trying to do is to help our users format CV's that are sent to us. We have an administration team which receives hundreds of cv's in .doc or .rtf format. I want them to open the cv & click a button on the Word toolbar which will insert our company logo and some text into the first page header of the cv and insert text into each page footer. I take your point about templates, but in this case my "template".doc just contains a header and footer with the logo and text to copy. Would love to hear if you have a simple solution.

John

 

[fumei]

I take your point about templates, but in this case my "template".doc just contains a header and footer with the logo and text to copy. Would love to hear if you have a simple solution.

Precisely what templates are for.


OK. Here is what I did.

1. made a template file. I put in header text, and a graphic, footer text and another graphic. I saved the file as TestTemplateCV.dot.

2. made 50 sample files, both .doc and .rtf, and put them in a folder - CVTest.

Ran the following code. It takes every file in the folder CVTest, opens it, clones a new document from the template TestTemplateCV (containing the header and footer text and graphic), duplicates the contents of the file into the clone, saves the cloned file as original filename_converted.

eg. fumeiCV.doc makes a new file fumeiCV_converted.doc

The original file is closed. The new file is closed. The next file in the folder is opened...and the process is repeated.

I have a fast machine it is true, but those 50 files took only 7 seconds to process. Obviously the time taken depends on what is in those files! The original files are not altered in any way. The process simply duplicates the content into a new file that has the header and footer from the template.

THIS is what templates are for.

NOTE: incoming .rtf files are saved as .doc files. If you want to, you certainly could save them as rtf as well.

Sub TestCVConversion()
Dim StartDoc As Document
Dim NewDoc As Document
Dim oContent
Dim strNewFile As String
[COLOR=red]' get filename and add "_converted" to it[/color red]
strNewFile = ActiveDocument.Path & -
  Application.PathSeparator & _
  Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4) _
  & "_converted.doc"
[COLOR=red]' set doc variable, content variable[/color red]
  Set StartDoc = ActiveDocument
  Set oContent = StartDoc.Content
[COLOR=red]' clone new doc, match content and save[/color red]
  Documents.Add Template:="C:\Temp\TestTemplateCV.dot"
  Set NewDoc = ActiveDocument
  With NewDoc
    .Content = oContent
    .SaveAs FileName:=strNewFile
  End With
[COLOR=red]' close and clean up[/color red]
  StartDoc.Close
  Set StartDoc = Nothing
  NewDoc.Close
  Set NewDoc = Nothing
End Sub

Sub ConvertFolderFiles()
Dim fso As Scripting.FileSystemObject
Dim fld As Scripting.Folder
Dim fil As Scripting.File
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder("C:\CVTest\")
[COLOR=red]' open each file and convert[/color red]
For Each fil In fld.Files
    Documents.Open FileName:=fil.Path
    Call TestCVConversion
Next
Set fld = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
End Sub

Final note: format of the files has not been mentioned. Are you using Styles? Will the incoming documents have Styles? This may be an issue. However, if you are just talking content with added headers and footers...yup, there is a simple solution. And it is not all that copying and pasting. Bleeeech. Yuck.

Gerry
My paintings and sculpture

 

[fumei]

Oh, and re: Different first page? That is set in the template file, so the new cloned file with the existing file contents will have that.

Gerry
My paintings and sculpture

 

[fumei]

Oh, and if you did not want to process a whole folder? Then make a macro button for TestCVConversion on a toolbar. It would do the conversion for the active document.

Gerry
My paintings and sculpture

 

[JohnnyLong]

Thanks again Gerry, I'm getting there slowly!

I have the TestCVConversion code behind a macro button. I have set up the .dot template with the headers and footers and in the Page Setup - Layout - checked the different first page box. However, I am still getting the header on each page. I need the header & footer on page 1, but only the footer on each following page.
Also, you're right, the original CV documents formatting is lost. Hate to say it but I may have to go back to copying & pasting!!:-(

John

 

[fumei]

Ok, first things first. There is an error in my code above.

strNewFile = ActiveDocument.Path & [COLOR=red]-[/color red]
  Application.PathSeparator & _
  Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4) _
  & "_converted.doc"

That dash needs to be an underscore!

RE: first page issue. In the template file make three empty pages. Use a page break (Ctrl-Enter) to make them. Make sure Different first page is set. Go into HeaderFooter view. Make sure the header is correct for First page. Move to the next page. Set it as NOT Same as previous - which is the default. This is why the header is repeated. After changing it to NOT same as previous, delete the contents of the header. This will make the header for everything not Firstpage, blank - which is, I believe what you want.

Now First page header WILL have the contents, the others will NOT. As you DO want the footers to have the same contents, you can keep them as Same as previous.

Once you have the headers and footers the way you want them across your three dummy pages, delete the dummy pages.

Word retains header and footer information in the Section. This persists whether the pages now exist, or not. So removing the pages will still keep the correct header/footers for those pages. When the new contents come in, and make new pages, the header/footer will be whatever was stored.

Format: a big one. This is why I asked about the use of Styles. However, as you are probably getting manually formatted documents....sigh...here is the way around it. It is using copy and paste, but as a Range...not a Selection.

Sub TestCVConversion()
Dim StartDoc As Document
Dim NewDoc As Document
Dim strNewFile As String
' get filename and add "_converted" to it
strNewFile = ActiveDocument.Path & _
  Application.PathSeparator & _
  Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4) _
  & "_converted.doc"
' set doc variable, copy range content
  Set StartDoc = ActiveDocument
  StartDoc.Range.Copy
' clone new doc, paste content and save
  Documents.Add Template:="C:\Test\CVConversion.dot"
  Set NewDoc = ActiveDocument
  With NewDoc
    .Range.PasteAndFormat (wdFormatOriginalFormatting)
    .SaveAs FileName:=strNewFile
  End With
' close and clean up
  StartDoc.Close
  Set StartDoc = Nothing
  NewDoc.Close
  Set NewDoc = Nothing
End Sub

Gerry
My paintings and sculpture

 

[JohnnyLong]

Brilliant
All works great.

Thanks alot Gerry, you are a star.

I had to change .Range.PasteAndFormat to .Range.PasteSpecial as I presume you have a later version of word.

Thanks again for your time, you are a credit to Tek-tips.

Regards,

John

 

[fumei]

Thank you, and you're welcome.

Gerry
My paintings and sculpture

 

[JohnnyLong]

Hi again. Following on from the above I have recently had to change the template .dot. As before it has a header and footer and now there is a table in the main body. Why is it that when the code is run, the table doesn't appear in the new document? Instead it seems to be pasted over. Any ideas?

My code:

Sub TestCVConversion()
Dim StartDoc As Document
Dim NewDoc As Document
Dim strNewFile As String
' get filename and add "_converted" to it
strNewFile = ActiveDocument.Path & _
Application.PathSeparator & _
Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4) & "_clean.doc"
' set doc variable, copy range content
Set StartDoc = ActiveDocument
StartDoc.Range.Copy
' clone new doc, paste content and save
Documents.Add Template:="C:\Temp\FormatNDCVTemplate.dot"
Set NewDoc = ActiveDocument
With NewDoc
.Range.PasteSpecial (wdFormatOriginalFormatting)
.SaveAs FileName:=strNewFile
End With
' close and clean up
StartDoc.Close
Set StartDoc = Nothing
NewDoc.Close
Set NewDoc = Nothing
End Sub

Thanks.

 

[fumei]

  Documents.Add Template:="C:\Temp\FormatNDCVTemplate.dot"
  Set NewDoc = ActiveDocument
  With NewDoc
    [b].Range.PasteSpecial (wdFormatOriginalFormatting)[/b]
    .SaveAs FileName:=strNewFile
  End With

You are pasting the entire range of the first document over the entire range of the new document.

Please describe precisely what you want to do.

Gerry
My paintings and sculpture

 

[JohnnyLong]

Hi Gerry,

I am trying to format CV's with a standard template. The template contains a header and a footer and a table in the main body. I want the user to open the CV and click the Format CV button on the toolbar in Word. This will insert the template header on the first page and footer on all subsequent pages, insert the template table on the first page and the cv text on the 2nd, 3rd etc pages. So the final document is:
Header
Table
Footer
CV text
Footer

Thanks for your help.

John

 

[fumei]

Let me see if I understand this correctly.

You have a document, a CV from someone. From a CV Format button (that fires your code) you want the contents of the ActiveDocument (the CV) to have:

- a first page with header and footer, and a table
- followed by the text of the current document (the CV) starting on the second page, with footer (no header)

Correct?

So, in the template, set it up.

1. Different first page: WITH header, WITH footer
2. make a page break
3. change header to be NOT Same as prvious
4. remove header content

OK, so now you have the template with your stuff on Page 1, and the header/footer for Page 2 properly set up (no header, with footer). There is nothing on Page 2, it just has the page break to make a page 2.

For for your code, simply move the Selection to the end of the document (ie. the top of Page 2). Paste the contents there.

  Set NewDoc = ActiveDocument
  With NewDoc
    .Selection.Endkey Unit:=wdStory
    .Selection.PasteSpecial (wdFormatOriginalFormatting)
    .SaveAs FileName:=strNewFile
  End With

Gerry
My paintings and sculpture

 

[JohnnyLong]

Thanks alot Gerry, you're a star.

I couldn't get Selection to be a property of ActiveDocument but this code works:

Set NewDoc = ActiveDocument
  With NewDoc
    .ActiveWindow.Selection.EndKey Unit:=wdStory
    .ActiveWindow.Selection.InsertBreak Type:=wdPageBreak
    .ActiveWindow.Selection.PasteSpecial (wdFormatOriginalFormatting)
    .SaveAs FileName:=strNewFile
  End With

John

 

[JohnnyLong]

Gerry, one more thing

Is there an easy way to copy the margin settings of the CV across? NewDoc uses the templates margins and this can alter the formatting of the CV. Not a big deal but a happy user is a quiet user!!

John

 

[fumei]

Whoa!

The point of a template is to use ONE setting. The template setting. The format, and structure of ALL of the documents will be the same. The template format and structure.

The point IS to alter the format of the CVs. No matter what the person sends you, they ALL come out looking the same.

If you want the sender to control the format...why are doing this at all? It is just to add the header/footer and table as a new page 1 to existing documents? If so, then....ummmm, perhaps you should be doing something else.

You could:

1. go to the start of the CV document
2. add a page
3. make first page different
4. explicitly alter page 2 header to NOT be Same as previous
5. insert the header into page 1
6. insert the table into page 1
7. insert footer - it will be for all pages

The header and footer contents could be part of the code, or as AutoText.

Again, please state EXACTLY what you want to do!

Selection is a property of the ActiveDocument, and it should work. Odd you say that it does not. Hmmm, try:

Set NewDoc = ActiveDocument
  With Selection
    .Endkey Unit:=wdStory
    .PasteSpecial (wdFormatOriginalFormatting)
  End With
NewDoc.SaveAs FileName:=strNewFile

Gerry
My paintings and sculpture

 

[JohnnyLong]

Hi Gerry,

We receive cv's in .doc or .rtf format. They always have different layouts; different margins, fonts, number of pages etc. I want to open the cv in Word, click the button on the toolbar and trigger the macro to do what you said above:

1. go to the start of the CV document
2. add a page
3. make first page different
4. explicitly alter page 2 header to NOT be Same as previous
5. insert the header into page 1
6. insert the table into page 1
7. insert footer - it will be for all pages

This is really what I was trying to do originally, but became convinced that a template was the way to go. The template method works, but I didn't appreciate it would alter the CV's formatting. You gave me some code earlier in this thread:

Sub CopyStuff()
    Dim oOriginalHeader As Word.HeaderFooter
    Dim oOriginalFooter As Word.HeaderFooter
    Dim oNewHeader As Word.HeaderFooter
    Dim oNewFooter As Word.HeaderFooter
    Dim oContent
    Dim TempDoc As Document
    Dim tmpFileName As String
    Dim OriginalFilePathName As String

    OriginalFilePathName = ActiveDocument.FullName
    tmpFileName = "C:\Test\tmpDoc.doc"

' save as different name
' set doc object
    ActiveDocument.SaveAs (tmpFileName)
    Set TempDoc = ActiveDocument
' Open Template Document
' although this is NOT a template
    Documents.Open FileName:="C:\Test\FormatCVTemplate.doc"
' set header/footer objects
' set Content object
    Set oOriginalHeader = _
     ActiveDocument.Sections(1).Headers(1)
    Set oOriginalFooter = _
     ActiveDocument.Sections(1).Footers(1)
    Set oContent = ActiveDocument.Content
' make sure First Page set
    TempDoc.PageSetup.DifferentFirstPageHeaderFooter = True
' set tempdoc header/footer objects
' and make objects match
    Set oNewHeader = TempDoc.Sections(1).Headers(wdHeaderFooterFirstPage)
    Set oNewFooter = TempDoc.Sections(1).Footers(wdHeaderFooterFirstPage)
    oNewHeader.Range = oOriginalHeader.Range
    oNewFooter.Range = oOriginalFooter.Range
' match the content objects
    TempDoc.Content = oContent
' save doc
    TempDoc.SaveAs FileName:=OriginalFilePathName
    ActiveDocument.Close wdDoNotSaveChanges
End Sub

Is this on the right track?

Thanks,

John

 

[fumei]

No, not quite.

First of all, tell me what is going on with that first page. What is in the header - just text? What is in the footer? Just text? What is with the table?

Gerry
My paintings and sculpture