#1
|
|||
|
|||
How to move Section 1.0 (Heading 1) into third page in vba word
Hi All, I'm new to create the vba for word. I would like to get advice from expert here.
I would like to shift the "section 1.0 definition" from page 2 to page 3. Where the section 1.0 always will start from page 3 instead of page 2. Refer to the image as attached. * Due to I had more than 1k files that need to shift the section 1.0 from page 2 to page 3, so I would like to use macro vba to restructure it. Appreciate someone can help me on this. Thanks in advance |
#2
|
||||
|
||||
Do you want the DEFINITION section at the top of page 3? If so simply inserting a page break before the paragraph could do the job -see below.
If this doesn't work for you, can you post the document instead of a screen shot so we can see how it is constructed with regard to styles, page breaks and white space? Code:
Sub Macro1() Dim oRng As Range Set oRng = ActiveDocument.Range With oRng.Find .ClearFormatting .Replacement.ClearFormatting .Text = "DEFINITION" .Style = "Heading 1" .Replacement.Text = "DEFINITION" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False Do While .Execute If ListParaNum(oRng.Paragraphs(1)) = 1 Then oRng.Paragraphs(1).Range.InsertBefore Chr(12) Exit Do End If Loop End With End Sub Private Function ListParaNum(oPara As Paragraph) As String Dim i As Integer Dim xRefs As Variant xRefs = ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem) ListParaNum = 0 With oPara.Range If .ListParagraphs.Count = 0 Then GoTo lbl_Exit End If .Collapse wdCollapseEnd On Error Resume Next For i = 1 To UBound(xRefs) If ActiveDocument.ListParagraphs(i).Range.End = .End Then ListParaNum = Val(ActiveDocument.ListParagraphs(i).Range.ListFormat.ListString) Exit For End If Next i End With lbl_Exit: Exit Function End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
Hi Gmayor, Thanks for the replied and code provided.
The code provided able to solve only 1 file as I tried up. Maybe due to my explanation not good enough, refer to below for more clear explanation. What I would like to do or purpose for the macro: Step 1. Removed all the headers and footers information for files that saved under a folder (This folder content files that more than 1k's files). -->I able to do so by used the code provided in this forum. Step 2. Would like to put section 1 at the top of page 3 for all the files saved under this folder. ( Section 1 title vary from files to files). For this case, how can I inserting a page break for the paragraph? Step 3. Update fields for Table of contents. Attached with the code for removed the header and footers information for all files that saved in a folder. File--> Example 1 and Example 2 as example of my document for your reference. Due to vary of files to files for the Section 1 title, thus i only able to share this 2 files. Appreciate your help and thank you so much! |
#4
|
|||
|
|||
Attached with the code below. But still unable to figure out how to move heading 1.0 to start at page 3 although no error when running the macro. Any expert can guide me on this? Thanks!
Sub UpdateDocumentHeaders() Application.ScreenUpdating = False Dim strFolder As String, strFile As String Dim wdDocTgt As Document, wdDocSrc As Document Dim Sctn As Section, HdFt As HeaderFooter Dim oPara As Paragraph Dim r As Range strFolder = GetFolder If strFolder = "" Then Exit Sub Set wdDocSrc = ActiveDocument strFile = Dir(strFolder & "\*.doc", vbNormal) While strFile <> "" If strFolder & "" & strFile <> wdDocSrc.FullName Then Set wdDocTgt = Documents.Open(FileName:=strFolder & "" & strFile, _ AddToRecentFiles:=False, Visible:=False) With wdDocTgt For Each Sctn In .Sections 'For Headers For Each HdFt In Sctn.Headers With HdFt If .Exists Then If Sctn.Index = 1 Then .Range.FormattedText = _ wdDocSrc.Sections.First.Headers(HdFt.Index).Range. FormattedText .Range.Characters.Last = vbNullString ElseIf .LinkToPrevious = False Then .Range.FormattedText = _ wdDocSrc.Sections.First.Headers(HdFt.Index).Range. FormattedText .Range.Characters.Last = vbNullString End If End If End With Next 'For footers For Each HdFt In Sctn.Footers With HdFt If .Exists Then If Sctn.Index = 1 Then .Range.FormattedText = _ wdDocSrc.Sections.First.Footers(HdFt.Index).Range. FormattedText .Range.Characters.Last = vbNullString ElseIf .LinkToPrevious = False Then .Range.FormattedText = _ wdDocSrc.Sections.First.Footers(HdFt.Index).Range. FormattedText .Range.Characters.Last = vbNullString End If End If End With Next 'For Heading 1 start at page 3 For Each oPara In wdDocTgt.Paragraphs If oPara.Style = "Heading 1" Then Set r = oPara.Range With r .Collapse Direction:=wdCollapseEnd .InsertBreak Type:=wdPageBreak End With End If Next wdDocTgt.PageSetup.FooterDistance = InchesToPoints(0.6) wdDocTgt.PageSetup.HeaderDistance = InchesToPoints(0.8) Next .Close SaveChanges:=True End With End If strFile = Dir() Wend Set wdDocSrc = Nothing: Set wdDocTgt = Nothing Application.ScreenUpdating = True End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder( 0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function |
#5
|
||||
|
||||
When you say you want Heading 1.0 to move to page three, what page is it currently on? If it is on page two it would be easiest to just have the Heading style include a 'Page Break Before' on its paragraph setting.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#6
|
|||
|
|||
Normally the Heading 1.0 will be on page 2 (after removed batch of the files for header and footer).
How to write a code for -->the Heading style include a 'Page Break Before' on its paragraph setting? Need your guidance, thanks and appreciate it! |
#7
|
|||
|
|||
I tried this but doesn't work.
StyleName = "Heading 1" If wdDocTgt.Styles(StyleName).ParagraphFormat.PageBre akBefore Then MsgBox StyleName & " has 'Page break before' set. Run aborted" Exit Sub End If Set wdDocTgt = ActiveDocument Selection.HomeKey unit:=wdStory With Selection.Find .ClearFormatting .Style = wdDocTgt.Styles(StyleName) .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop End With Do While Selection.Find.Execute If Asc(Selection.Range.Characters(1)) = 12 Then Selection.MoveStart unit:=wdCharacter, Count:=1 End If Selection.Start = Selection.End Loop |
#8
|
||||
|
||||
You could do either:
This one sets a style change so all heading 1's start a new page ActiveDocument.Styles(wdStyleHeading1).ParagraphFo rmat.PageBreakBefore = True This one just changes the first heading in the document ActiveDocument.Range.GoTo(What:=wdGoToHeading, Which:=wdGoToFirst ).ParagraphFormat.PageBreakBefore = True
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#9
|
|||
|
|||
Hi Guessed,
Thanks for the guidance. I tried first one which change all heading it's work. Second choice doesn't work for my files and dont have any message error when running the code. Would like to ask about your comment regarding to my code as below: Sub UpdateDocumentHeaders() Application.ScreenUpdating = False Dim strFolder As String, strFile As String Dim wdDocTgt As Document, wdDocSrc As Document Dim Sctn As Section, HdFt As HeaderFooter strFolder = GetFolder If strFolder = "" Then Exit Sub Set wdDocSrc = ActiveDocument strFile = Dir(strFolder & "\*.doc", vbNormal) While strFile <> "" If strFolder & "" & strFile <> wdDocSrc.FullName Then Set wdDocTgt = Documents.Open(FileName:=strFolder & "" & strFile, _ AddToRecentFiles:=False, Visible:=False) With wdDocTgt For Each Sctn In .Sections 'For Headers For Each HdFt In Sctn.Headers With HdFt If .Exists Then If Sctn.Index = 1 Then .Range.FormattedText = _ wdDocSrc.Sections.First.Headers(HdFt.Index).Range. FormattedText .Range.Characters.Last = vbNullString ElseIf .LinkToPrevious = False Then .Range.FormattedText = _ wdDocSrc.Sections.First.Headers(HdFt.Index).Range. FormattedText .Range.Characters.Last = vbNullString End If End If End With Next 'For footers For Each HdFt In Sctn.Footers With HdFt If .Exists Then If Sctn.Index = 1 Then .Range.FormattedText = _ wdDocSrc.Sections.First.Footers(HdFt.Index).Range. FormattedText .Range.Characters.Last = vbNullString ElseIf .LinkToPrevious = False Then .Range.FormattedText = _ wdDocSrc.Sections.First.Footers(HdFt.Index).Range. FormattedText .Range.Characters.Last = vbNullString End If End If End With Next 'For Heading 1 start at page 3 wdDocTgt.Range.GoTo(What:=wdGoToHeading, Which:=wdGoToFirst).ParagraphFormat.PageBreakBefor e = True wdDocTgt.PageSetup.FooterDistance = InchesToPoints(0.6) wdDocTgt.PageSetup.HeaderDistance = InchesToPoints(0.8) Next .Close SaveChanges:=True End With End If strFile = Dir() Wend Set wdDocSrc = Nothing: Set wdDocTgt = Nothing Application.ScreenUpdating = True End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder( 0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function Thanks! |
#10
|
||||
|
||||
What sort of comments do you want?
If you are iterating through objects in a collection, what is the point of testing whether they exist? Could it be in the collection if it didn't exist? Even though you tested for its existence when it must exist, you then assumed it exists in the source document (ie first page, odd and even all present in section 1 of source doc). Following your process, instead of the ElseIf I would have just set it to Else .LinkToPrevious = True End If I don't know what your headers/footers are like in the source document but I would expect varying page widths (margins, page sizes and orientations) and different style definitions across 1000 files so it is unlikely throwing the same content in will give you exact copies of the layout & fonts. Similarly, your code is not changing the settings for different first page or odd/even headers so that is likely to vary in results expected.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Word 2007, cannot insert Section Break (Continuous), only Section Break (Next Page) | btse1 | Word | 3 | 11-01-2018 09:23 AM |
Restarting page numbering only if Section begins with Heading 1 | kaurp | Word VBA | 5 | 11-02-2017 04:36 AM |
Changing a Section Heading to an Appendix Heading | stardazy | Word | 2 | 11-24-2015 01:04 PM |
Cross Reference Heading Number with the word "Section" included | bblouin | Word | 5 | 12-20-2012 05:27 PM |
Prefixing heading numbers with custom letters, varying by section, in Microsoft Word? | JoelMarcey | Word | 0 | 07-23-2011 08:51 AM |