Help with VBA

[Zack]

With Selection
.EndKey Unit:=wdStory
.InsertBreak Type:=wdSectionBreakNextPage
.InsertFile FileName:="C:\Documents and Settings\lorien\My Documents\zen.doc", Range:=""

End With

Dim oSec As Section
Dim sPrintCode As String


For Each oSec In ActiveDocument.Sections
sPrintCode = sPrintCode & oSec.Range.Information(wdActiveEndPageNumber) & ","
Next


sPrintCode = Left(sPrintCode, Len(sPrintCode) - 1)


ActivePrinter = "Jingo2"
Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:=sPrintCode, PageType:= _
wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, Background:= _
True, PrintToFile:=False, PrintZoomColumn:=0, PrintZoomRow:=0, _
PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0



End Sub

What it does basically is that it creates a new section in the document and adds zen.doc to the first page of the 2'nd section.

Now the trick is, how to implement something in this code in order to change the font, alignment, etc of the 2'nd section before the printing occurs, but without affecting the 1'st section and the content of it?

For example: default font and size is Arial 10 on both the main document and zen.doc. I need this code to run and change font to Arial 20 and only for the zen. doc, before the print. How to make changes that will affect everything on the section 2, but Nothing on the section 1 and to implement it within this code?

Thank you.

[fumei]

Learn to use Styles properly. If you have a style - say Section2Style

ActiveDocument.Sections2).Range.Style="Section2Style"

Done.

If you only have two Sections, why are you using For Each????

Why use a For Each (even if you have 1,000 Sections) at all???

[Zack]

I understand.
Thank you fumei.

How to implement changing font of the section2 Before the printing.

Where would I implement this code of yours in my code above to achieve that.

[fumei]

With Selection
.EndKey Unit:=wdStory
.InsertBreak Type:=wdSectionBreakNextPage
.InsertFile FileName:="C:\Documents and Settings\lorien\My Documents\zen.doc", Range:=""

End With
ActiveDocument.Sections2).Range.Style="Section2Style" I am not sure what you are trying to do with the Print code.

[Zack]

With Selection
.EndKey Unit:=wdStory
.InsertBreak Type:=wdSectionBreakNextPage
.InsertFile FileName:="C:\Documents and Settings\lorien\My Documents\zen.doc", Range:=""

End With
ActiveDocument.Sections2).Range.Style="Section2Style"

That's it. It will basically print section 2 free of section's 1 format.

Thx

[fumei]

Only if it HAS a different format. Using a SAtyle will do that.

[Zack]

With Selection
.EndKey Unit:=wdStory
.InsertBreak Type:=wdSectionBreakNextPage
.InsertFile FileName:="C:\Documents and Settings\lorien\My Documents\zen.doc", Range:=""

End With
ActiveDocument.Sections2).Range.Style="Section2Style"

Doesn't work / Compile error, Syntax error

[Zack]

With Selection
.EndKey Unit:=wdStory
.InsertBreak Type:=wdSectionBreakNextPage
.InsertFile FileName:="C:\Documents and Settings\lorien\My Documents\zen.doc", Range:=""

ActiveDocument.Sections2).Range.Style="Section2Style"

End With

Dim oSec As Section
Dim sPrintCode As String


For Each oSec In ActiveDocument.Sections
sPrintCode = sPrintCode & oSec.Range.Information(wdActiveEndPageNumber) & ","
Next


sPrintCode = Left(sPrintCode, Len(sPrintCode) - 1)


ActivePrinter = "Jingo2"
Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:=sPrintCode, PageType:= _
wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, Background:= _
True, PrintToFile:=False, PrintZoomColumn:=0, PrintZoomRow:=0, _
PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0

End Sub


Compile error, syntax error

[Frosty]

ActiveDocument.Sections(2)
Will refer to section 2.

[Zack]

ActiveDocument.Sections(2)
Will refer to section 2.


With Selection
.EndKey Unit:=wdStory
.InsertBreak Type:=wdSectionBreakNextPage
.InsertFile FileName:="C:\Documents and Settings\lorien\My Documents\zen.doc", Range:=""

ActiveDocument.Sections(2).Range.Style="Section2Style"

End With

Dim oSec As Section
Dim sPrintCode As String


For Each oSec In ActiveDocument.Sections
sPrintCode = sPrintCode & oSec.Range.Information(wdActiveEndPageNumber) & ","
Next


sPrintCode = Left(sPrintCode, Len(sPrintCode) - 1)


ActivePrinter = "Jingo2"
Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:=sPrintCode, PageType:= _
wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, Background:= _
True, PrintToFile:=False, PrintZoomColumn:=0, PrintZoomRow:=0, _
PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0

End Sub

Run-time error 5834

[fumei]

Do you actually HAVE a style Section2Style?

[Zack]

Do you actually HAVE a style Section2Style?

Section 2 style is the style of the document zen.doc, meaning that it has different font size, alignment etc. compared to section 1. Thus it has to keep it rather than just assuming the Section's 1 font, alignment etc.

[fumei]

Think.

Does it in fact keep that style? Clearly it does not, otherwise you would not be having this problem.

So..........

[Zack]

Think.

Does it in fact keep that style? Clearly it does not, otherwise you would not be having this problem.

So..........

It keeps the style from the section 1, for some reason..
I need section 2 clear of that

[fumei]

1. It keeps the style from the section 1, for some reason..

Word always does that. Pasting takes on format of the document it is pasted into.

2. I need section 2 clear of that

Then do as I have suggested. Make it that style.

[Zack]

1. It keeps the style from the section 1, for some reason..

Word always does that. Pasting takes on format of the document it is pasted into.

2. I need section 2 clear of that

Then do as I have suggested. Make it that style.

I tried your code, but it doesn't work..

Basic idea was to copy zen.doc into the original doc without it assuming original docs style.

[macropod]

Instead of using Insertfile, have you considered copy & paste? Check out the different paste options - one of them retains the source formatting.

[Zack]

Instead of using Insertfile, have you considered copy & paste? Check out the different paste options - one of them retains the source formatting.

Unfortunately I need it to work with the code I've posted.

If it's impossible it's ok.

[Frosty]

What? But the code you've posted does *not* work. So that will be impossible.

Do you mean that you are obligated to the .InsertFile method for some reason, despite an alternative method being easier to implement your specifications?

[Zack]

What? But the code you've posted does *not* work. So that will be impossible.

Do you mean that you are obligated to the .InsertFile method for some reason, despite an alternative method being easier to implement your specifications?

I am obligated to .InsertFile method for the reasons which I am not allowed to talk about.

Fumei said:

With Selection
.EndKey Unit:=wdStory
.InsertBreak Type:=wdSectionBreakNextPage
.InsertFile FileName:="C:\Documents and Settings\lorien\My Documents\zen.doc", Range:=""

End With
ActiveDocument.Sections(2).Range.Style="Section2Style"

So .InsertFile method was calculated within it. Unfortunately it does not work.

Is there a way to enable this code?

[fumei]

Sorry, but I find it hard to believe you can not talk about why you need to use InsertFile. And if it is that constricted, and you neither appear to try and understand or work with how things work...I am not sure we can help.

"Is there a way to enable this code?"

YES! Make sure the document (not zen.doc) has the style, and bloody well apply it.

I have some serious issues with this problem. If you are inserting zen.doc into another document (as section 2), and then appear to want to print Section 2...why not simply just print zen.doc?

Back to your problem:

"Basic idea was to copy zen.doc into the original doc without it assuming original docs style."

But you are NOT copying zen.doc!!! Your "idea" is flawed. It is NOT copied. You are inserting it.

If it WAS copied then - as macropod suggests - you can retain formatting.

Or, IF the target document has the style you want, you can apply the style quite simply, as I have suggested.

If - for the reasons you can not state - your environment is so weirdly restricted that it does not allow you to use Word as it actually works, then I am afraid you are SOL. The fact of the matter is that you CAN do what you say you want. If there is no viable solution it is not a problem with VBA, it is the unknown problem that you can not talk about.

[Zack]

Make sure the document (not zen.doc) has the style, and bloody well apply it.

Oh it has the style alright.




You are inserting it.



That's right.


Why this doesn't work?

With Selection
.EndKey Unit:=wdStory
.InsertBreak Type:=wdSectionBreakNextPage
.InsertFile FileName:="C:\Documents and Settings\lorien\My Documents\zen.doc", Range:=""

End With
ActiveDocument.Sections(2).Range.Style="Section2Style"

[fumei]

What does not work? The section does not get the style applied?

[Zack]

What does not work? The section does not get the style applied?

No.

I get the error message posted before.

[fumei]

So you get Compile error/ syntax error?

[macropod]

I am obligated to .InsertFile method for the reasons which I am not allowed to talk about.
IMHO that's crap. Do you really mean to say you can't use something like:
Sub Demo()
Application.ScreenUpdating = False
Dim wdDoc As Document, strFile As String, Rng As Range
'Copy the required content from the source document
'strFile = "C:\Documents and Settings\lorien\My Documents\zen.doc"
Set wdDoc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
.Range.Copy
.Close SaveChanges:=False
End With
With ActiveDocument
Set Rng = .Sections(1).Range
With Rng
'If there's already a Section break, move back one character
If Asc(.Characters.Last) = 12 Then
.End = .End - 1
End If
'Ensure there's an empty paragraph for the new Section.
While Asc(.Characters.Last.Previous) <> 13
.InsertAfter vbCr
Wend
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
End With
'Add the new Section
.Sections.Add Range:=Rng, Start:=wdSectionNewPage
With Sections(2)
Set Rng = .Range
With Rng
.Collapse wdCollapseStart
'Insert the new content, retaining its formatting
.PasteAndFormat Type:=wdFormatOriginalFormatting
End With
End With
End With
Set wdDoc = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

[fumei]

Well I am not sure it is crap or not, but it is odd and doubtful. I mean it is possible (I suppose) that there may be company rules for copying and pasting, but it is hard to think why this would be.

That being said, your posted code is rather advanced for someone who does not know how to create and use a string variable. Besides if the environment is that restricted the OP may not be able to use it.

[Zack]

So you get Compile error/ syntax error?

Run-time error 5834

[Zack]

your posted code is rather advanced for someone who does not know how to create and use a string variable.

Very advanced. I don't even know how to use macropod's code..similar to Insert.file method..

[Zack]

IMHO that's crap. Do you really mean to say you can't use something like:
Sub Demo()
Application.ScreenUpdating = False
Dim wdDoc As Document, strFile As String, Rng As Range
'Copy the required content from the source document
'strFile = "C:\Documents and Settings\lorien\My Documents\zen.doc"
Set wdDoc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
.Range.Copy
.Close SaveChanges:=False
End With
With ActiveDocument
Set Rng = .Sections(1).Range
With Rng
'If there's already a Section break, move back one character
If Asc(.Characters.Last) = 12 Then
.End = .End - 1
End If
'Ensure there's an empty paragraph for the new Section.
While Asc(.Characters.Last.Previous) <> 13
.InsertAfter vbCr
Wend
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
End With
'Add the new Section
.Sections.Add Range:=Rng, Start:=wdSectionNewPage
With Sections(2)
Set Rng = .Range
With Rng
.Collapse wdCollapseStart
'Insert the new content, retaining its formatting
.PasteAndFormat Type:=wdFormatOriginalFormatting
End With
End With
End With
Set wdDoc = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub


On "With sections (2)" I get Compile error: Sub or function not defined

[macropod]

I don't know what happend with the posted code, but 'With Sections(2)' should read 'With .Sections(2)'.

[fumei]

If you are getting the run-time error it usually means you have typed something incorrectly. Post the ENTIRE code that is giving you the error. Not a part, all of it.

[Zack]

If you are getting the run-time error it usually means you have typed something incorrectly. Post the ENTIRE code that is giving you the error. Not a part, all of it.

Sub Macropod()

Application.ScreenUpdating = False
Dim wdDoc As Document, strFile As String, Rng As Range
'Copy the required content from the source document
strFile = "C:\Documents and Settings\lorien\My Documents\zen.doc"
Set wdDoc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
.Range.Copy
.Close SaveChanges:=False
End With
With ActiveDocument
Set Rng = .Sections(1).Range
With Rng
'If there's already a Section break, move back one character
If Asc(.Characters.Last) = 12 Then
.End = .End - 1
End If
'Ensure there's an empty paragraph for the new Section.
While Asc(.Characters.Last.Previous) <> 13
.InsertAfter vbCr
Wend
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
End With
'Add the new Section
.Sections.Add Range:=Rng, Start:=wdSectionNewPage
With .Sections(2)
Set Rng = .Range
With Rng
.Collapse wdCollapseStart
'Insert the new content, retaining its formatting
.PasteAndFormat Type:=wdFormatOriginalFormatting
End With
End With
End With
Set wdDoc = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

Had to move ' before strFile but it works. However, section 2 uses the same header as section 1.

With Selection
.EndKey Unit:=wdStory
.InsertBreak Type:=wdSectionBreakNextPage
.InsertFile FileName:="C:\Documents and Settings\lorien\My Documents\zen.doc", Range:=""

End With

Dim oSec As Section
Dim sPrintCode As String


For Each oSec In ActiveDocument.Sections
sPrintCode = sPrintCode & oSec.Range.Information(wdActiveEndPageNumber) & ","
Next


sPrintCode = Left(sPrintCode, Len(sPrintCode) - 1)


ActivePrinter = "Jingo2"
Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:=sPrintCode, PageType:= _
wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, Background:= _
True, PrintToFile:=False, PrintZoomColumn:=0, PrintZoomRow:=0, _
PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0



End Sub

This code deletes the header of the section 1 for the inserted file into the section 2 of the document.

Isn't there a solution to use this existing code and just make it keep the settings of the inserted file?

[macropod]

If you want to preserve each document's headers etc, then you have to include code to do that. And, if the page layouts differ, you need code for that also. For a fairly comprehensive example, try the following. If the page layouts are the same, you won't need the second sub; otherwise, use both and uncomment the 'Call' line:
Sub ImportDocument()
Application.ScreenUpdating = False
Dim wdDoc As Document, strFile As String, Rng As Range, HdFt As HeaderFooter, i As Long
strFile = "C:\Users\Macropod\Documents\Attachments\Faces.docx"
'strFile = "C:\Documents and Settings\lorien\My Documents\zen.doc"
With ActiveDocument
'If there is more than one Section, unlink the headers & footers from the 1st Section
' so that the new Section's content won't impact subsequent Sections
If .Sections.Count > 1 Then
With .Sections(2)
For Each HdFt In .Headers
HdFt.LinkToPrevious = False
Next
For Each HdFt In .Footers
HdFt.LinkToPrevious = False
Next
End With
End If
Set Rng = .Sections(1).Range
With Rng
'If there's already a Section break, move back one character
If Asc(.Characters.Last) = 12 Then
.End = .End - 1
End If
'Ensure there's an empty paragraph for the new Section.
While Asc(.Characters.Last.Previous) <> 13
.InsertAfter vbCr
Wend
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
End With
'Add the new Section
.Sections.Add Range:=Rng, Start:=wdSectionNewPage
' Unlink the headers & footers from the 1st Section
' so that the new Section's content won't impact first Section
With .Sections(2)
'Insert the new content, retaining its formatting
Set wdDoc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False, Visible:=False)
For Each HdFt In .Headers
HdFt.LinkToPrevious = False
Next
For Each HdFt In .Footers
HdFt.LinkToPrevious = False
Next
Set Rng = .Range
Rng.Collapse wdCollapseStart
With wdDoc
.Range.Copy
Rng.PasteAndFormat Type:=wdFormatOriginalFormatting
i = .Sections.Count
'Call ReplicateLayout(wdDoc.Sections(i), ActiveDocument.Sections(i + 1))
For Each HdFt In .Sections(i).Headers
With ActiveDocument.Sections(i + 1)
If .Headers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Headers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
With ActiveDocument.Sections(i + 1)
If .Footers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Footers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
.Close SaveChanges:=False
End With
End With
End With
Set wdDoc = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub
Sub ReplicateLayout(ScnIn As Section, ScnOut As Section)
'Document Body variables
Dim sPageHght As Single, sPageWdth As Single
Dim sHeaderDist As Single, sFooterDist As Single
Dim sTMargin As Single, sBMargin As Single
Dim sLMargin As Single, sRMargin As Single
Dim sGutter As Single, sGutterPos As Single
Dim lPaperSize As Long, lGutterStyle As Long
Dim lMirrorMargins As Long, lVerticalAlignment As Long
Dim lScnStart As Long, lScnDir As Long
Dim lOddEvenHdFt As Long, lDiffFirstHdFt As Long
Dim bTwoPagesOnOne As Boolean, bBkFldPrnt As Boolean
Dim bBkFldPrnShts As Boolean, bBkFldRevPrnt As Boolean
Dim bOrientation As Boolean
With ScnIn
'Populate Document Body variables
With .PageSetup
lPaperSize = .PaperSize
lGutterStyle = .GutterStyle
bOrientation = .Orientation
lMirrorMargins = .MirrorMargins
lScnStart = .SectionStart
lScnDir = .SectionDirection
lOddEvenHdFt = .OddAndEvenPagesHeaderFooter
lDiffFirstHdFt = .DifferentFirstPageHeaderFooter
lVerticalAlignment = .VerticalAlignment
sPageHght = .PageHeight
sPageWdth = .PageWidth
sTMargin = .TopMargin
sBMargin = .BottomMargin
sLMargin = .LeftMargin
sRMargin = .RightMargin
sGutter = .Gutter
sGutterPos = .GutterPos
sHeaderDist = .HeaderDistance
sFooterDist = .FooterDistance
bTwoPagesOnOne = .TwoPagesOnOne
bBkFldPrnt = .BookFoldPrinting
bBkFldPrnShts = .BookFoldPrintingSheets
bBkFldRevPrnt = .BookFoldRevPrinting
End With
End With
With ScnOut
With .PageSetup
.GutterStyle = lGutterStyle
.MirrorMargins = lMirrorMargins
.SectionStart = lScnStart
.SectionDirection = lScnDir
.OddAndEvenPagesHeaderFooter = lOddEvenHdFt
.DifferentFirstPageHeaderFooter = lDiffFirstHdFt
.VerticalAlignment = lVerticalAlignment
.PageHeight = sPageHght
.PageWidth = sPageWdth
.TopMargin = sTMargin
.BottomMargin = sBMargin
.LeftMargin = sLMargin
.RightMargin = sRMargin
.Gutter = sGutter
.GutterPos = sGutterPos
.HeaderDistance = sHeaderDist
.FooterDistance = sFooterDist
.TwoPagesOnOne = bTwoPagesOnOne
.BookFoldPrinting = bBkFldPrnt
.BookFoldPrintingSheets = bBkFldPrnShts
.BookFoldRevPrinting = bBkFldRevPrnt
.PaperSize = lPaperSize
.Orientation = bOrientation
End With
End With
End Sub

[fumei]

For Each oSec In ActiveDocument.Sections
sPrintCode = sPrintCode & oSec.Range.Information(wdActiveEndPageNumber) & ","
Next Never did answer why you are doing this For Each.

The fact of the matter is that it does not matter. It is a useless piece of code...as you never actually use any difference in Sections. You only ever use the LAST one. sPrintCode only ends up with the values from the LAST Section. The For Each is totally pointless.

I just looked at your previous postings. Ah. I now recognize you.

As you - hopefully - are now seeing, your request is possible, but you are not doing yourself any favours at all by not paying attention, or giving full information. You never mentioned that you wanted to retain headers.

Good luck. Please pay attention to what macropod is posting.

[Zack]

If you want to preserve each document's headers etc, then you have to include code to do that. And, if the page layouts differ, you need code for that also. For a fairly comprehensive example, try the following. If the page layouts are the same, you won't need the second sub; otherwise, use both and uncomment the 'Call' line:
Sub ImportDocument()
Application.ScreenUpdating = False
Dim wdDoc As Document, strFile As String, Rng As Range, HdFt As HeaderFooter, i As Long
'strFile = "C:\Users\Macropod\Documents\Attachments\Faces.docx"
strFile = "C:\Documents and Settings\lorien\My Documents\zen.doc"
With ActiveDocument
'If there is more than one Section, unlink the headers & footers from the 1st Section
' so that the new Section's content won't impact subsequent Sections
If .Sections.Count > 1 Then
With .Sections(2)
For Each HdFt In .Headers
HdFt.LinkToPrevious = False
Next
For Each HdFt In .Footers
HdFt.LinkToPrevious = False
Next
End With
End If
Set Rng = .Sections(1).Range
With Rng
'If there's already a Section break, move back one character
If Asc(.Characters.Last) = 12 Then
.End = .End - 1
End If
'Ensure there's an empty paragraph for the new Section.
While Asc(.Characters.Last.Previous) <> 13
.InsertAfter vbCr
Wend
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
End With
'Add the new Section
.Sections.Add Range:=Rng, Start:=wdSectionNewPage
' Unlink the headers & footers from the 1st Section
' so that the new Section's content won't impact first Section
With .Sections(2)
'Insert the new content, retaining its formatting
Set wdDoc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False, Visible:=False)
For Each HdFt In .Headers
HdFt.LinkToPrevious = False
Next
For Each HdFt In .Footers
HdFt.LinkToPrevious = False
Next
Set Rng = .Range
Rng.Collapse wdCollapseStart
With wdDoc
.Range.Copy
Rng.PasteAndFormat Type:=wdFormatOriginalFormatting
i = .Sections.Count
'Call ReplicateLayout(wdDoc.Sections(i), ActiveDocument.Sections(i + 1))
For Each HdFt In .Sections(i).Headers
With ActiveDocument.Sections(i + 1)
If .Headers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Headers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
With ActiveDocument.Sections(i + 1)
If .Footers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Footers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
.Close SaveChanges:=False
End With
End With
End With
Set wdDoc = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub


It keeps the section one's header..tried it several times..

[macropod]

Zack,

There is no need to quote back at people the entirety of their posts. Please don't do it. If there's a particular statement in the post you need to comment on, fine, quote that, but not the entire post.

As for the Section 1 header, are you now saying (which you've never mentioned before) that you want to replace the active document's header with the header from the inserted document?

[Zack]

As for the Section 1 header, are you now saying (which you've never mentioned before) that you want to replace the active document's header with the header from the inserted document?

No. I just don't want the inserted document to use the header of the section one.

[macropod]

Replace:

[vba] For Each HdFt In .Sections(i).Headers
With ActiveDocument.Sections(i + 1)
If .Headers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Headers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
%

[Zack]

Replace:

[vba] For Each HdFt In .Sections(i).Headers
With ActiveDocument.Sections(i + 1)
If .Headers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Headers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
%

Replace it with what?

[macropod]

I have no idea what happened to my last post - there was a whole lot more there after I posted it. Trying again.

Replace:
'Call ReplicateLayout(wdDoc.Sections(i), ActiveDocument.Sections(i + 1))
For Each HdFt In .Sections(i).Headers
With ActiveDocument.Sections(i + 1)
If .Headers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Headers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
With ActiveDocument.Sections(i + 1)
If .Footers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Footers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
with:
'Call ReplicateLayout(.Sections(i), Rng.Sections(i))
' Replicate the last Section's headers & footers.
For Each HdFt In .Sections(i).Headers
With Rng.Sections(i).Headers(HdFt.Index)
If .Exists Then
HdFt.Range.Copy
.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
With Rng.Sections(i).Footers(HdFt.Index)
If .Exists Then
HdFt.Range.Copy
.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Range.Characters.Last.Delete
End If
End With
Next

[Zack]

Doesn't work. I tried it several times. It deletes all headers from both section 1 and section 2.

Here is the code I used.

Application.ScreenUpdating = False
Dim wdDoc As Document, strFile As String, Rng As Range, HdFt As HeaderFooter, i As Long
'strFile = "C:\Users\Macropod\Documents\Attachments\Faces.docx"
strFile = "C:\Documents and Settings\jingo\My Documents\lopsy.docx"
With ActiveDocument
'If there is more than one Section, unlink the headers & footers from the 1st Section
' so that the new Section's content won't impact subsequent Sections
If .Sections.Count > 1 Then
With .Sections(2)
For Each HdFt In .Headers
HdFt.LinkToPrevious = False
Next
For Each HdFt In .Footers
HdFt.LinkToPrevious = False
Next
End With
End If
Set Rng = .Sections(1).Range
With Rng
'If there's already a Section break, move back one character
If Asc(.Characters.Last) = 12 Then
.End = .End - 1
End If
'Ensure there's an empty paragraph for the new Section.
While Asc(.Characters.Last.Previous) <> 13
.InsertAfter vbCr
Wend
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
End With
'Add the new Section
.Sections.Add Range:=Rng, Start:=wdSectionNewPage
' Unlink the headers & footers from the 1st Section
' so that the new Section's content won't impact first Section
With .Sections(2)
'Insert the new content, retaining its formatting
Set wdDoc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False, Visible:=False)
For Each HdFt In .Headers
HdFt.LinkToPrevious = False
Next
For Each HdFt In .Footers
HdFt.LinkToPrevious = False
Next
Set Rng = .Range
Rng.Collapse wdCollapseStart
With wdDoc
.Range.Copy
Rng.PasteAndFormat Type:=wdFormatOriginalFormatting
i = .Sections.Count
'Call ReplicateLayout(wdDoc.Sections(i), ActiveDocument.Sections(i + 1))
For Each HdFt In .Sections(i).Headers
With Rng.Sections(i).Headers(HdFt.Index)
If .Exists Then
HdFt.Range.Copy
.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
With Rng.Sections(i).Footers(HdFt.Index)
If .Exists Then
HdFt.Range.Copy
.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Range.Characters.Last.Delete
End If
End With
Next
.Close SaveChanges:=False
End With
End With
End With
Set wdDoc = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

[fumei]

Have fun Paul.

[macropod]

Doesn't work. I tried it several times. It deletes all headers from both section 1 and section 2.
Not when I use it ...

When I use it, even on a document that already has two or more Sections, the newly-inserted Section 2's content is completely independent of the Sections before and after. All of the preceding and following content is preserved.

[Zack]

Not when I use it ...

When I use it, even on a document that already has two or more Sections, the newly-inserted Section 2's content is completely independent of the Sections before and after. All of the preceding and following content is preserved.

I tried it again. It deletes header from all pages, both sections.
I am using exactly what I posted here.

[Zack]

Basically, this code deletes the header from the section 2, but keeps the style from the section 1.

With Selection
.EndKey Unit:=wdStory
.InsertBreak Type:=wdSectionBreakNextPage
.InsertFile FileName:="C:\Documents and Settings\lorien\My Documents\zen.doc", Range:=""

End With

Dim oSec As Section
Dim sPrintCode As String


For Each oSec In ActiveDocument.Sections
sPrintCode = sPrintCode & oSec.Range.Information(wdActiveEndPageNumber) & ","
Next


sPrintCode = Left(sPrintCode, Len(sPrintCode) - 1)


ActivePrinter = "Jingo2"
Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:=sPrintCode, PageType:= _
wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, Background:= _
True, PrintToFile:=False, PrintZoomColumn:=0, PrintZoomRow:=0, _
PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0



End Sub

Since this code does the job well, is there a way to incorporate saving style of section 2 (inserted document) in it?

[fumei]

This is just the same thing you asked at the start, over and over again.

And you have been answered, over and over again.

You are abusing this forum. Smarten up or I will formally ask that you be removed.

[macropod]

I tried it again. It deletes header from all pages, both sections.
I am using exactly what I posted here.
I ran the code from your post with my data and the headers were preserved.

The problem is your's. As I said:

When I use it, even on a document that already has two or more Sections, the newly-inserted Section 2's content is completely independent of the Sections before and after. All of the preceding and following content is preserved.
As far as I am concerned, you're a waste of time. Aside from anything else, we've at least proved that your previous post about:

obligated to .InsertFile method for the reasons which I am not allowed to talk about
was indeed crap. The code works for everything you have specified - and more. I'm done with this.

[fumei]

No, not just smarten up. You need to apologize. In fact, if you do not apologize FIRST - no other postings about how something is not working - then I will ask for you to be removed.

[Zack]

No, not just smarten up. You need to apologize. In fact, if you do not apologize FIRST - no other postings about how something is not working - then I will ask for you to be removed.

Apologize in your stead for not bringing solution to this issue? I am not that benevolent..However, it seems that your fragile ego has been hurt, thus I understand your desire of "removing" a user from this forum. Natural response of a lesser man..

Best regards.

[fumei]

Apologize in your stead for not bringing solution to this issue?

Except for a simple fact...we DID bring a solution. You were warned.

[Zack]

Except for a simple fact...we DID bring a solution. You were warned.

No you didn't. The code does not work. I have no reason to lie.

Warned about being honest? Wonderful..

[fumei]

Warned about being honest? No, I did no such thing. I warned you about your behaviour. The fact that you make that comment just demonstrates once again you do not get it.

Everyone else: I have formally asked that Zack be removed from the forum. I think that any other postings to these threads are pointless.

[Frosty]

I was actually going to chime in and say it's not worth your time, Fumei. New user names can be created. No need to get heated about it... the person posting under the username Zack is either a) a troll, b) feels entitled to free help for some reason c) has some kind of language barrier thing going on and it's all a big misunderstanding.

Personality types A and B aren't worth engaging any more. Personality type C can simply try again in a new thread. But the question of this thread has been asked and answered as well as it could have been, much like the other thread.

Can lead a horse to water and all that :)

[fumei]

Sorry, but I do not think a, b, OR c applies.

a) troll. Perhaps, but I an inclined to think not. I think Zack truly wants an answer. He is simply not willing to work with the forum, or work with himself to see the answer.

b) No, well maybe yes, in that he does not want to pay anything. The point is that he is getting free help. He is simply not willing to work with the forum, or work with himself to see the answer.

c) language. I doubt this very much - as I have covered in another thread "Detecting last page VBA". Zack uses phrases like "Nah, mate". That thread ALSO caused much frustration (and not just with me).

Time? It took 10 seconds to PM the admin to look at this. Far less than the time we have wasted trying to help.

Heated? No, not really. This site has helped and assisted many people, and I have been here from the very beginning. I have a fondness for it. I am simply trying to keep it clean.

Can someone get a new name and try again? Yes I suppose. But I seriously doubt someone can hide their character - and yes, I do think it is a reflection of character. Unless they altered their behaviour significantly (in which case they are very welcome), they will be recognized.

Look, just about all of the major contributors to the forum have expressed frustration and annoyance with how this is going, not just me. "I am done here" has been stated over again, and not just me.

I am (was?) not looking for an abject apology. I just want a recognition, from the OP, that they are the primary cause of the problem. That when we ask for a response to a simple question - did you try this? - ignoring that IS a primary cause of the problem. Repeatedly parroting back the same thing over and over again does not lead to a solution. That stating this does not work (with no explanation or information) does not lead to a solution.

"Horse to water and all that". Yes, precisely. And yes, true, the solution to a horse refusing to drink when it is in front of water, is to walk away and let the darn horse either drink, or not. BUT... if that horse is blocking others from the water, or that horse is sucking up resources (I.e. the people leading it to water over and over again), then it needs to be dealt with.

Obscure reference: title of early Jane Fonda movie...