Copy/Paste/Delete Table & Section etc.

flds · #31 07-09-2011, 05:32 AM

Hi Paul,

Thanks for your response.

Quote:

Do the numbers & captions occur before, or after, the pictures?

The numbers & captions occur after, the pictures and are centered.

Quote:

Are they part of the same paragraph, or are they separate paragraphs?

It may be a separate paragraph. If it is just 1 or 2 lines of code, enter both I will comment block one of them.

Quote:

does the 'Design Requirements' portion of the document consist of one Section?

Yes, it consist of one section.

Thanks
FLDS

macropod · #32 07-11-2011, 04:38 AM

Hi flds,

Try this new version of the 'ParseDocs' sub with other subs in my previous post:

Code:

Sub ParseDocs()
Application.ScreenUpdating = False
Dim strInFold As String, strOutFold As String, strFile As String, strOutFile As String
Dim TOC As TableOfContents, Para As Paragraph, Tbl As Table, Sctn As Section, Rng As Range
Dim DocSrc As Document, DocOutline As Document, DocTxt As Document, DocTbl As Document
Dim DocApp As Document, DocRef As Document, oShp As Shape, iShp As InlineShape
'Call the GetFolder Function to determine the folder to process
strInFold = GetFolder
If strInFold = "" Then Exit Sub
strFile = Dir(strInFold & "\*.doc", vbNormal)
'Check for documents in the folder - exit if none found
If strFile <> "" Then strOutFold = strInFold & "\Output\"
'Test for an existing outpfolder & create one if it doesn't already exist
If Dir(strOutFold, vbDirectory) = "" Then MkDir strOutFold
strFile = Dir(strInFold & "\*.doc", vbNormal)
'Process all documents in the chosen folder
While strFile <> ""
  Set DocSrc = Documents.Open(FileName:=strInFold & "\" & strFile, AddTorecentFiles:=False, Visible:=False)
  With DocSrc
    Set DocOutline = Documents.Add(Visible:=False)
    Call CreateOutline(DocSrc, DocOutline)
    'Delete everything before the first Table Of Contents in the source document
    If .TablesOfContents.Count <> 0 Then
      Set Rng = .TablesOfContents(1).Range
      Rng.Start = .Range.Start
      Rng.Delete
    End If
    'Delete any other Tables Of Contents in the source document
    For Each TOC In .TablesOfContents
      TOC.Delete
    Next TOC
    'Convert all fields in the source document to plain text
    .Fields.Unlink
    With Content.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      'Convert non-breaking hyphens to ordinary hyphens
      .Text = "^~"
      .Replacement.Text = "-"
      .Execute Replace:=wdReplaceAll
      'Delete manual page breaks
      .Text = "^m"
      .Replacement.Text = ""
      .Execute Replace:=wdReplaceAll
    End
    For Each oShp In .Shapes
      oShp.Delete
    Next oShp
    For Each iShp In .InlineShapes
      With iShp.Range.Paragraphs.First.Range
        With .Next.Paragraphs.First
          If .Style = "Caption" Then .Range.Delete
        End With
        .Delete
      End With
    Next iShp
    'Check for tables in the source document
    If .Tables.Count > 0 Then
      'If there are any tables in the source document, make a copy of the document
      .Range.Copy
      ' Create a new document for the tables
      Set DocTbl = Documents.Add(Visible:=False)
      'Process the new document
      Call MakeTableDoc(DocTbl)
    End If
    'Delete all tables in the source document
    For Each Tbl In .Tables
      Tbl.Delete
    Next Tbl
    'Check for appendices in the source document
    For Each Sctn In .Sections
      If UCase(Trim(Sctn.Range.Words.First)) = "APPENDIX" Then
        Set Rng = Sctn.Range
        Rng.End = .Range.End
        'Cut the from the start of the first appendices Section to the end of the
        'source document and paste it into a new appendices document
        Rng.Cut
        Set DocApp = Documents.Add(Visible:=False)
        'Process the new document
        Call NewDoc(DocApp)
        Exit For
      End If
    Next Sctn
    'Check for References in the source document
    For Each Sctn In .Sections
      If UCase(Trim(Sctn.Range.Words.First)) = "REFERENCES" Then
        Set Rng = Sctn.Range
        Rng.End = .Range.End
        'Cut the from the start of the first References Section to the end of the
        'source document and paste it into a new references document
        Rng.Cut
        Set DocRef = Documents.Add(Visible:=False)
        'Process the new document
        Call NewDoc(DocRef)
        Rng.End = .Range.End
        Rng.Cut
        Exit For
      End If
    Next Sctn
    'Check for Design Requirements in the source document
    For Each Sctn In .Sections
      If UCase(Sctn.Range.Sentences.First) Like "#*DESIGN REQUIREMENT*" Then
        Set Rng = Sctn.Range
        'Cut the 'Design Requirement' Section from the
        'source document and paste it into a new references document
        Rng.Cut
        Set DocDesReq = Documents.Add(Visible:=False)
        'Process the new document
        Call NewDoc(DocDesReq)
        'Delete everything after the 'Design Requirement' Section
        Rng.End = .Range.End
        Rng.Delete
        Exit For
      End If
    Next Sctn
    Call Cleanup(.Range)
    'String variable for the output filenames
    strOutFile = strOutFold & Split(.Name, ".")(0)
    'Copy whatever's left in the source document and paste it into a new text document
    .Range.Copy
    Set DocTxt = Documents.Add(Visible:=False)
    With DocTxt
      .Range.Paste
      'Save and close the text document
      .SaveAs FileName:=strOutFile & "-Text", AddTorecentFiles:=False
      .Close
    End With
    Set DocTxt = Nothing
    'Save and close the Outline document
    With DocOutline
      .SaveAs FileName:=strOutFile & "-Outline", AddTorecentFiles:=False
      .Close
    End With
    'Save and close the tables document
    If Not DocTbl Is Nothing Then
      DocTbl.SaveAs FileName:=strOutFile & "-Tables", AddTorecentFiles:=False
      DocTbl.Close
      Set DocTbl = Nothing
     End If
      'Save and close the appendices document
    If Not DocApp Is Nothing Then
      DocApp.SaveAs FileName:=strOutFile & "-Appendices", AddTorecentFiles:=False
      DocApp.Close
      Set DocApp = Nothing
    End If
    'Save and close the references document
    If Not DocRef Is Nothing Then
      DocRef.SaveAs FileName:=strOutFile & "-References", AddTorecentFiles:=False
      DocRef.Close
      Set DocRef = Nothing
     End If
    'Save and close the design requirements document
    If Not DocDesReq Is Nothing Then
      DocDesReq.SaveAs FileName:=strOutFile & "-Design Requirements", AddTorecentFiles:=False
      DocDesReq.Close
      Set DocDesReq = Nothing
     End If
    'Close the source document without saving the changes we've made to it
    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
Set Rng = Nothing: Set DocOutline = Nothing: Set DocSrc = Nothing
Application.ScreenUpdating = True
End Sub

flds · #33 07-12-2011, 07:27 AM

Hi Paul,

Thanks for the modified code.

This is what I wanted, the code runs as expected. Just for one portion of the code “Design Requirements” is not as expected.

Quote:

“If UCase(Sctn.Range.Sentences.First) Like "#*DESIGN REQUIREMENTS*" Then”

Code:

 
'Check for Design Requirements in the source document
For Each Sctn In .Sections
If UCase(Sctn.Range.Sentences.First) Like "#*DESIGN REQUIREMENTS*" Then
Set Rng = Sctn.Range
'Cut the 'Design Requirement' Section from the
'source document and paste it into a new references document
Rng.Cut
Set DocDesReq = Documents.Add(Visible:=False)
'Process the new document
Call NewDoc(DocDesReq)
'Delete everything after the 'Design Requirement' Section
Rng.End = .Range.End
Rng.Delete
Exit For
End If
Next Sctn

This ‘#’ character does not seem to be a wildcard character in word 2007.

With this ‘#’ character in place the file is not created in the output folder.
When this ‘#’ character is removed I get the file in the output folder, but only 1 section that says ‘DESIGN REQUIREMENTS’, the other section that says ‘CONTROL DESIGN REQUIREMENTS’ is not created.

Playing around with it, when I use a space "* DESIGN REQUIREMENTS*" it creates the ‘CONTROL DESIGN REQUIREMENTS’ section but not the ‘DESIGN REQUIREMENTS’ section. Frankly, I tried all the wildcard characters with no success.
To get both sections into the output folder, I believe, there should be a solution. I am sure you will know the trick.

Thanks
FLDS

macropod · #34 07-12-2011, 06:16 PM

Hi flds,

The '#' character in a vba 'Like' stands for a digit. The '*' character stands for a string. Try using:
If InStr(UCase(Sctn.Range.Sentences.First), "DESIGN REQUIREMENT") > 0 Then

flds · #35 07-13-2011, 06:40 AM

Hi Paul,

Quote:

Try using:
If InStr(UCase(Sctn.Range.Sentences.First), "DESIGN REQUIREMENT") > 0 Then

I tried, no success. It is same as before, it just creates one section. I also tried by inserting "*DESIGN REQUIREMENT*" no files were created.

There should be a way to get this done. I hope to be successful.

Thanks
FLDS

macropod · #36 07-14-2011, 05:13 AM

Quote:

Originally Posted by flds

I tried, no success. It is same as before, it just creates one section.

Since you previously specified that the Design Requirements consisted of only one Section, that's all the code I wrote looks for! If there is more than one such Section, then you need to give some indication as to how one can reliably determine find how many such Sections there are. For example, does each such Section have the Words 'Design Requirements' or some form of that string as part of the first sentence in the Section? If not, is there always a 'Code and Standards' Section that follows the last 'Design Requirements' Section?

flds · #37 07-14-2011, 05:57 AM

Hi Paul,

Quote:

Since you previously specified that the Design Requirements consisted of only one Section, that's all the code I wrote looks for!

Sorry, I did not understand your question in post # 29. See quote below.

Quote:

Qoute by Paul
Does the 'Design Requirements' portion of the document only ever comprise one Section? What do you want done with the 'Code and Standards' etc Sections that follow it?”

Quote:

Quote by FLD
Paul, Yes it comprise of one group of section with sub sections (i.e. 4. 'Design Requirements', 4.1. XXXXXXXX, 4.2. XXXXXXX, 4.2.1. XXXXXXX, 8. 8.1, 8.2, 8.2.1, etc.)

You will notice in Post # 20 and 26 I said that the document may contain more the 1 section that contains 'Design Requirements'

Quote:

For example, does each such Section have the Words 'Design Requirements' or some form of that string as part of the first sentence in the Section?

Yes, each section will have the words 'Design Requirements'

Yes, 'Design Requirements' may also be part of a string of the first sentence in the section.

I might have not correctly explained my requirements on 'Design Requirements' in my earlier post. Sorry for that.

I hope I am now clear.

Thanks
FLDS

macropod · #38 07-14-2011, 07:27 AM

Quote:

Originally Posted by flds

You will notice in Post # 20 and 26 I said that the document may contain more the 1 section that contains 'Design Requirements'

And, when I sought clarification, in terms of Word Section breaks (which is what I've used for everything else):

Quote:

Regarding the 'Design Requirements' portion of the document, when I refer to 'Section' I mean a Word Section defined via Section breaks - Word has no such thing as sub-sections. So, does the 'Design Requirements' portion of the document consist of one Section?

you replied with:

Quote:

Yes, it consist of one section.

So, to get the code to work with multiple consecutive 'Design Requirement' Sections, change the line:

Code:

Dim DocApp As Document, DocRef As Document, oShp As Shape, iShp As InlineShape

to:

Code:

Dim DocApp As Document, DocRef As Document, oShp As Shape, iShp As InlineShape, SubSctn As Section

and, replace:

Code:

      If InStr(UCase(Sctn.Range.Sentences.First), "DESIGN REQUIREMENT") > 0 Then
        Set Rng = Sctn.Range
        'Cut the 'Design Requirement' Section from the
        'source document and paste it into a new references document
        Rng.Cut

with:

Code:

      If InStr(UCase(Sctn.Range.Sentences.First), "DESIGN REQUIREMENT") > 0 Then
        Set Rng = Sctn.Range
        Rng.End = .Range.End
        'Find the end of the last 'Design Requirements' Section
        For Each SubSctn In Rng.Sections
          If InStr(UCase(SubSctn.Range.Sentences.First), "DESIGN REQUIREMENT") = 0 Then
            Rng.End = SubSctn.Range.Start - 1
            Exit For
          End If
        Next
        'Cut the 'Design Requirement' Sections from the
        'source document and paste them into a a new design requirements document
        Rng.Cut

flds · #39 07-14-2011, 01:07 PM

Hi Paul,

Thanks for your reply.

I replaced and changed the lines as mentioned and test run the code. NO success.

I am adding an outline of a document as an example, to give you an idea what is required.
I need complete sections of 2 (Design Requirements) and sections 7 (CONTROL DESIGN REQUIREMENTS) ONLY.

This example is not in all documents,
- in ALL documents one section is always as section 2,
- in some document it may be as sections 2 and 7
- in some documents it may be as Section 2, 7 or as section 10. Design Requirements Process Systems
The words “DESIGN REQUIREMENTS” is common.

Document Outline

1. INTRODUCTION

2. Design Requirements

2.1 Functional Requirements

2.2 Performance Requirements

2.2.1 Warm-Up

2.2.2 Start Up

2.3 Safety Requirements

2.3.1 General

3. PROCESS SYSTEM DESCRIPTION

3.1 General

3.1.1 System Arrangement

3.2 Equipment Description

3.2.1 Steam Generators

3.2.2 Heat Transport Pumps

3.2.2.1 General

4. Commissioning

4.1 Hydrostatic Test

4.2 Pump Operation without Fuel in the Reactor

4.2.1 General

5. OPERATION

5.1 Operating Conditions

5.2 Normal Operation

6. PROCESS DESIGN CONSIDERATIONS

6.1 Heat Transport System Operating Conditions

6.2 Fluid Velocities

7. CONTROL DESIGN REQUIREMENTS

7.1 General

7.2 System Classification

7.3 Safety Requirements

7.3.1 General

7.3.2 Seismic Qualification and PAM Requirements

8. CONTROL SYSTEM DESCRIPTION

8.1 General

8.2 Heat Transport Pump Motor Control

9. REFERENCES

9.1 System Flowsheets

9.2 Design Manuals

Appendix

I hope this will explains my requirements
Thanks
FLDS

macropod · #40 07-14-2011, 03:13 PM

Hi flds,

Change:
SubSctn As Section
to:
i As Long
and replace everything between:
'Check for Design Requirements in the source document
and:
'String variable for the output filenames
with:

Code:

    For Each Sctn In .Sections
      If InStr(UCase(Sctn.Range.Sentences.First), "DESIGN REQUIREMENT") > 0 Then
        Set Rng = Sctn.Range
        'Delete anything after the first 'Design Requirements' Section that isn't
        'also a 'Design Requirements' Section
        Rng.End = .Range.End
        For i = Rng.Sections.Count To 2 Step -1
          If InStr(UCase(Rng.Sections(i).Range.Sentences.First), "DESIGN REQUIREMENT") = 0 Then _
            Rng.Sections(i).Range.Delete
        Next
        'Cut the 'Design Requirement' Sections from the source document
        'and paste them into a new design requirements document
        Rng.Cut
        Set DocDesReq = Documents.Add(Visible:=False)
        'Process the new document
        Call NewDoc(DocDesReq)
        Exit For
      End If
    Next Sctn
    Call Cleanup(.Range)

flds · #41 07-16-2011, 07:34 AM

Hi Paul,

Thank you so much. This is what I was looking for. If it was not for you I would have struggled doing all this manually.
You have devoted so much of your precious time to help me solve my requirements. I hope I was not a disturbance, as I know you were studying for your exams and still helped me. I have no words to express my thanks to you. I wish you all the best.

Thanks once again

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
copy and paste not working	Ellie	Word	3	11-07-2013 02:23 PM
Can't copy paste	irenasobolewska	Office	2	10-26-2012 05:09 PM
Copy - Paste between 2 tables	rod147	Excel	1	10-22-2009 08:21 PM
Copy & paste low resolution	worriedme	Drawing and Graphics	0	06-01-2009 03:05 AM
Copy and paste special	Dace	Excel	2	02-16-2009 12:18 PM