SHAPES IN HEADER

[Zig999]

What I need seams to be simple, but its driving me nuts.
I need to open a doc and put a watermark in all headers, with this config:

- it has to allow multiple sections.
- the very first page (this means, page 1 of section 1) has a diferent header.

What I´m doing till now is: I have a doc (a model) with the shape I want to paste in all headers. I open the model, copy the shape. The problem is when pasting the shape in header.. I can´t get it done right.

That´s it. I already try to do it in lots of ways.. I need your help people...

Thanks.

Zig

 

[SkipVought]

Hi,

What are the symptoms for, "...can´t get it done right"?

Try changing the Layout of the shape from InLine to anything else.


Skip,

_{[red]Be Advised![/red]
A wee deranged psychic may be runnin' around out there!
SMALL MEDUIM @ LARGE}

 

[fumei]

I need to open a doc and put a watermark in all headers, with this config:

- it has to allow multiple sections.
- the very first page (this means, page 1 of section 1) has a diferent header.

1. watermarks are, traditionally, used to cover a page, not just a header. Why are you doing it in the header?

2. "it has to allow multiple sections". Uh...what is the "it" you mention? I have no idea what "it" may be. And what do you mean by multiple sections. Documents can have multiple sections certainly. They often do. But I do not understand what you mean by :allow". Allow?

3. Different first page is not a problem.

Does the document already have sections breaks? Or are you doing something within your code?

You want to do something by code obviously. Could you please walk it through, step-by-step?

Gerry

 

[Zig999]

LEt me explain better what happens.
For example.. Once I tried

(I have already copied the shape from my Model Document. My activeDocument, is a simple doc with 4 sections)

For i = 1 To .ActiveDocument.Sections.Count
			.Selection.GoTo wdGoToSection,wdGoToAbsolute,i,""		
			If .ActiveDocument.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
				wrddoc.ActiveWindow.Panes(2).Close
			End If
			If .ActiveDocument.ActiveWindow.ActivePane.View.Type = wdNormalView Or .ActiveDocument.ActiveWindow.ActivePane.View.Type = wdOutlineView Then
				.ActiveDocument.ActiveWindow.ActivePane.View.Type = wdPrintView
			End If
			.ActiveDocument.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
			With .Selection.PageSetup
				.OddAndEvenPagesHeaderFooter = False
				.DifferentFirstPageHeaderFooter = True
			End With		
			'.Selection.Paste
			.ActiveDocument.Sections(i).Headers(2).Range.Paste	
		Next

What I get as result is a document, with the firt page of each section with 4 shapes pasted in the header. What I wanted as result in this particular case with this code was 1 shape in the first page of each section (assuming that each section has its own FirstPage heather).

Sorry if it sound confusing... I´m trying to be as clear as I can.. I´m brazilian.. so my English is not so good.

Thanks.

 

[Zig999]

Fumei, I just saw your answer...
Thanks for answering.. I´ve been reading some of your threads since yesterday, hope you can help me.
I posted an example of I am trying to do and can´t get it done right.

When I said watermarks.. what I mean is something like a STAMP, imagine something like TOP SECRET stamp in the middle of a document.

The stamp needs to be placed in every page of a document; but, in the very first page, this stamp is diferent.

I can get it done if my document only have 1 section. But I need a solution to documents with ltos of sections.

Thanks again

Zig

 

[SkipVought]

If the watermark is inserted in the Header or Footer, it will appear on every page in the document or section.

If you have multiple sections and the headers are the same, use the Same as Previous property and insert the watermark only one time.

Otherwise, a separate watermark object is required for each separate section that is not the Same as Previous.

Size & format the watermark accordingly.


Skip,

_{[red]Be Advised![/red]
A wee deranged psychic may be runnin' around out there!
SMALL MEDUIM @ LARGE}

 

[macropod]

Hi Zig,

Try something like:

Sub InsertHeaderShapes()
Dim oSection As Section
Dim oHead As HeaderFooter
For Each oSection In ActiveDocument.Sections
    For Each oHead In oSection.Headers
        If Not oHead.LinkToPrevious Then oHead.Range.Paste
    Next
Next
End Sub

Cheers

 

[Zig999]

Hey, thanks for your time answering.
Skip, as I need a diferent Stamp in the first page of the first section (and only in this first page), I cant´s use Same as Previous on Section 2, but from section 2 to the end, yes, I agree, I can try this.

Macropod, I don´t know why but, if I use something like you said, every time I paste something, it is pasted on the first section. This is something I can´t understand, if I use something like this:

- sections(3).headers(2).range.text = "my text here"
The result is that in the first page of Section 3 the header has this text.
But, this one:
- sections(3).headers(2).range.paste (let´s say I have already copied a shape)
The shape is pasted on section 1!!!???!??!WTF?? Anybody knows why???

 

[macropod]

Hi Zig,

I tested the code before I posted it to confirm that it does paste once in each header in each section.

If your first section has three headers (1st page, odd, even), then three images would be pasted - one in each header.

Cheers

 

[Zig999]

Thanks macropod for answering.

I just tried your sugestion. I used a document with 4 sections.
The result I get was 6 shapes pasted in the first section.
It pasted 3 shapes for section(1).Headers
end one more shape for section(2).Headers,section(3).Headers and section(4).Headers. Well.. that sound ok, cause Section 1 have the Primary, FirstPage and EvenPage Header (3 shapes).. and the others sections have only the (primary). But as I said, all the shapes were pasted in the section(1) Header??!?!?!? the Word version in the server used is Word XP 2002.
here is the code

   Set wrd = CreateObject("Word.Application")	
   Set model = wrd.documents.open(tempdir & "\amod.doc")
   model.Sections(2).Range.ShapeRange.Select
   model.Application.Selection.Copy
   Set EditDocument = wrd.documents.open (tempdir+"\adoc.doc")	
   With EditDocument
	Forall section In .Sections
           Print "<p>-Section</p>"
              Forall header In section.Headers
                 Print "<p>-----Header</p>"
		 If Not header.LinkToPrevious Then 
		     Print "<p>-------------Paste</p>"
			header.Range.Paste
		 End If				
              End Forall
	 End Forall		
     .Save
     .Close
End With	
Call wrd.Quit (False)

Any ideia?
Thanks again for helping.

 

[fumei]

Let me see if I have it right.

1. Section 1 first page has Shape_A.
2. Section 1 odd page has Shape_B.
3. Section 1 even page also has Shape_B.
4. Section 2 and ALL other sections and headers have Shape_B.

In other words the first page has a different shape from ALL the other pages. ALL the other pages have the same shape.

Is this correct?

Gerry

 

[Zig999]

Fumei, yes, you got it right.
But this afternoon I just got into a solution and made the rules a litle bit diferent. I´m using a model doc from where I copy the STAMP. This model has 2 sections, and each section has a diferent STAMP. I´ll use this acording to the page Layout, Portrait pages has STAMP 1 and Landscape pages will have STAMP 2.
So:

1. Section 1 first page has Shape_A. (ALWAYS)
2. for odd and even on other sections:
if Landscape then shape = _B
if Portrait then shape = _A

Here is the code I´m using.

Set wrd = CreateObject("Word.Application")
	
Set wrdModel = wrd.documents.open(tempdir + "\" + modelFileName)	
Set wrdToEdit = wrd.documents.open (tempdir+"\"+Document.FileName)

[COLOR=red]'activate the Model Document and copy the shape on section 1[/color]
wrdModel.Activate
wrdModel.Sections(1).Range.ShapeRange.Select
wrdModel.Application.Selection.Copy
wrdToEdit.Activate

With wrdToEdit					
	[COLOR=red]'First, I delete every possible older STAMP tha the edited document could have[/color]
	Forall section In .Sections
		Forall header In section.Headers
			Forall hShape In header.Shapes
				Dim shapeFix As Integer
				shapeFix = Fix(hShape.Height)
				If shapeFix <= 54 And shapeFix >= 52 Then
					hShape.delete
				End If
			End Forall
		End Forall
	End Forall
		
	[COLOR=red]'First Page[/color]
	.Application.Selection.HomeKey 6		
	.Application.Selection.GoTo 0,1,1,""
	With .Application.Selection.PageSetup
		.OddAndEvenPagesHeaderFooter = False
		.DifferentFirstPageHeaderFooter = False
	End With
	.Sections(1).Headers().Item(1).LinkToPrevious = False
	.Sections(1).Headers().Item(2).LinkToPrevious = False
	.Sections(1).Headers().Item(3).LinkToPrevious = False		
	.Sections(1).Headers(1).Range.Paste
	With .Application.Selection.PageSetup
		.OddAndEvenPagesHeaderFooter = False
		.DifferentFirstPageHeaderFooter = True
	End With
	.Sections(1).Headers(2).Range.Paste
	
	[COLOR=red]'All other pages[/color]
	Dim i As Integer
	For i = 2 To .Sections.Count
		.Application.Selection.GoTo 0,1,i,""
		With .Application.Selection.PageSetup
			.OddAndEvenPagesHeaderFooter = False
			.DifferentFirstPageHeaderFooter = False
		End With
		.Sections(i).Headers().Item(1).LinkToPrevious = False
		.Sections(i).Headers().Item(2).LinkToPrevious = False
		.Sections(i).Headers().Item(3).LinkToPrevious = False
	Next	
		
	For i = 2 To .Sections.Count
		.Application.Selection.GoTo wdGoToSection,wdGoToAbsolute,i,""
		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		
	
		[COLOR=red]'Paste diferent STAMP for Layout PORTRAIT or LANDSCAPE[/color]
		If .Sections(i).PageSetup.Orientation = 0 Then
			'PORTRAIT
			wrdModel.Activate
			wrdModel.Sections(1).Range.ShapeRange.Select
			wrdModel.Application.Selection.Copy
			wrdToEdit.Activate
		Else
			'LANDSCAPE
			wrdModel.Activate
			wrdModel.Sections(2).Range.ShapeRange.Select
			wrdModel.Application.Selection.Copy
			wrdToEdit.Activate
		End If
		.Sections(i).Headers(1).Range.Select
		.Application.Selection.Paste			
	Next			
	.Save
	.Close
End With
	
Call wrd.Quit (False)

If you people have some ideias to make the code better, faster, o wtver.. you're welcome.
Thanks for helping everyone. =)

 

[macropod]

Hi Zig,

I suggest you re-read the code I posted. Hint: "For Each", not "Forall".

Cheers

 

[fumei]

1. For Each .....
.........
NEXT

2. Could use some more With statements.

3. Coild do it better using Range, rather than Selection.

4. If use Range, the code for ActiveWindow.ActivePane.View is not needed.

Gerry

 

[Zig999]

Fumei, I just tried removing the ActiveWindow.ActivePane.View and using Range to paste the Stamps. I get a bloody result, all the stamps are pasted into section 1???!!!???!! This is what I cant understand.
If I use .Sections(i).Headers(1).Range.Text = "XXXXXXX" the text will be correctly positioned in i section.
When I use .Sections(i).Headers(1).Range.Paste, it always paste in the section 1.
That´s why I was using the ActiveWindow.ActivePane.View; to enter the Header/Footer view and paste the stamp in it.
Was this what you were meaning with "4. If use Range, the code for ActiveWindow.ActivePane.View is not needed. " I don´t know why it doesn´t work this way? What am I doing wrong fellows?
Thanks.
Zig

For i = 2 To .Sections.Count
	[COLOR=red]' removed the ActiveWindow.ActivePane.View [/color]
	If .Sections(i).PageSetup.Orientation = 0 Then
		wrdModel.Activate
		wrdModel.Sections(1).Range.ShapeRange.Select
		wrdModel.Application.Selection.Copy
		wrdToEdit.Activate
	Else
		wrdModel.Activate
		wrdModel.Sections(2).Range.ShapeRange.Select
		wrdModel.Application.Selection.Copy
		wrdToEdit.Activate
	End If
	[COLOR=red]' I took off the range.select and just try pasting it[/color]
	[COLOR=red]' it paste every Stamp in the first section[/color]
	.Sections(i).Headers(1).Range.Paste
Next

 

[macropod]

Hi Zig,

What is this 'Forall' statement you keep using?

To delete the unwanted shapes, I'd suggest using a separate module like:

Sub DeleteHeaderShapes()
Dim oSection As Section
Dim oHead As HeaderFooter
Dim oShape As Shape
Dim oShapeHt As Integer
For Each oSection In ActiveDocument.Sections
    For Each oHead In oSection.Headers
        If Not oHead.LinkToPrevious Then
            For Each oShape In oHead.Shapes
                 oShapeHt = Fix(oShape.Height)
                If oShapeHt <= 54 And oShapeHt >= 52 Then oShape.Delete
            Next
        End If
    Next
Next
End Sub

and calling it with:
Call DeleteHeaderShapes
(though the 'Call' isn't strictly necessary). Also, do you really need to test the shape heights? This doesn't seem to accord with your statement:
"delete every possible older STAMP"
What happens if someone re-sized one of the stamps?

Likewise, for the pasting, I'd suggest using a separate module like:

Sub InsertHeaderShapes()
Dim oSection As Section
Dim oHead As HeaderFooter
For Each oSection In ActiveDocument.Sections
    For Each oHead In oSection.Headers
        If oSection.Index = 1 Then
            oHead.Range.Paste
        ElseIf Not oHead.LinkToPrevious Then
            If oSection.PageSetup.Orientation = wdOrientPortrait Then
                wrdModel.Sections(1).Range.ShapeRange.Copy
            Else
                wrdModel.Sections(2).Range.ShapeRange.Copy
            End If
            oHead.Range.Paste
        End If
    Next
Next
End Sub

and calling it with:
Call InsertHeaderShapes


Cheers

 

[fumei]

Hi Zig,

m_pod's suggestions are, as always, good. Breaking things into task specific procedures is the right way to go.

The reason it was going into Section 1 is likely because of the LinkToPrevious. This while handy in someways, can also be an annoying "feature" in Word.

macropod's code is good as it iterates through all sections.

You can also explicitly access both sections and the headers in each section.

I have a question though. Your code indicates that you are copying the shape from the entire range of the section. This seems odd to me.

wrdModel.Sections(1).Range.ShapeRange.Select

This means the shape is the only one in the document section. Why is it in the MainStory? Is it just stored there for use by this code?

Gerry

 

[Zig999]

Hehehe, sorry m_pod.. I was just about to change I it, but I was so curiouse aboute tha Paste thing that I posted it that way. The motive that I test shape height is that the document header already has some other shapes (that are not stamps). And thanks very much for the sugestions.

Fumei... about the link to previous I have already set them before the pasting code.
This code is runed before the one I posted before.

Dim i As Integer
For i = 2 To .Sections.Count
	.Application.Selection.GoTo 0,1,i,""
	With .Application.Selection.PageSetup
		.OddAndEvenPagesHeaderFooter = False
		.DifferentFirstPageHeaderFooter = False
	End With
	        .Sections(i).Headers().Item(1).LinkToPrevious = False
		.Sections(i).Headers().Item(2).LinkToPrevious = False
		.Sections(i).Headers().Item(3).LinkToPrevious = False
Next

And then I paste everything. Even using this all the shapes are beeing pasted on section 1 and this is still making me nuts.
lol

Thank you for the help. Hope you can still help me to dscouver why is this happining.