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)