Hello P. Edstein,
Thank you so much for your reply.
Most of the documents are portrait and say few documents may have columns specially in the appendix sections. If I come across such situation I could do these sections manually or do the whole document manually.
I have found a few of the macros on the web, I do not know how to put them together in one macro. I would like to combine these macros into one macro, is it too much to do?
Paul, the Reference section is the second last section in the document. This is a string with bullets.
the Appendix section is the last section in all documents, it starts as “Appendix ‘A’ “ and so on.
The tables need to be copied first and then deleted.
The macro “CopyTablesIntoNewDocument()” works on some documents and does not work on some, can this be fixed.
The document does not need formatting.
I tried deleting the TOC it does not delete.
I hope you could combine all these macros into one. If possible to add a section delete macro.
Appreciate your time and effort.
Thanks again.
FLDS
Macros:
Code:
Sub HyperlinkDelete()
Dim i As Long
For i = ActiveDocument.Hyperlinks.Count To 1 Step -1
ActiveDocument.Hyperlinks(i).Delete
Next i
End Sub
Code:
Sub DeleteSectionBreaks()
With ActiveDocument.Content.Find
.ClearFormatting
.Text = "^b"
With .Replacement
.ClearFormatting
.Text = ""
End With
.Execute Replace:=wdReplaceAll
End With
End Sub
Code:
Sub ReplaceNonBreakingHyphen()
With ActiveDocument.Content.Find
.ClearFormatting
.Text = "^~"
With .Replacement
.ClearFormatting
.Text = "^-"
End With
.Execute Replace:=wdReplaceAll
End With
End Sub
Code:
Sub DeleteAllTables()
Dim oTable As Table
For Each oTable In ActiveDocument.Tables
oTable.Delete
Next oTable
End Sub
Code:
Sub SectionDelete()
Dim TOC As TableOfContents
Set TOC = ActiveDocument.TablesOfContents(1)
With ActiveDocument
.Sections(2).Range.Delete
TOC.Update
End With
End Sub
Code:
Sub CopyTablesIntoNewDocument()
' version 1.0
' http://www.pdfhacks.com/copytables/
Dim SrcDoc, NewDoc As Document
Dim SrcDocTableRange As Range
Set SrcDoc = ActiveDocument
If SrcDoc.Tables.Count <> 0 Then
Set NewDoc = Documents.Add(DocumentType:=wdNewBlankDocument)
Set NewDocRange = NewDoc.Range
Dim PrevPara As Range
Dim NextPara As Range
Dim NextEnd As Long
NextEnd = 0
For Each SrcDocTable In SrcDoc.Tables
Set SrcDocTableRange = SrcDocTable.Range
'output the preceding paragraph?
Set PrevPara = SrcDocTableRange.Previous(wdParagraph, 1)
If PrevPara Is Nothing Or PrevPara.Start < NextEnd Then
Else
Set PPWords = PrevPara.Words
If PPWords.Count > 1 Then 'yes
NewDocRange.Start = NewDocRange.End
NewDocRange.InsertParagraphBefore
NewDocRange.Start = NewDocRange.End
NewDocRange.InsertParagraphBefore
NewDocRange.FormattedText = PrevPara.FormattedText
End If
End If
'output the table
NewDocRange.Start = NewDocRange.End
NewDocRange.FormattedText = SrcDocTableRange.FormattedText
'output the following paragraph?
Set NextPara = SrcDocTableRange.Next(wdParagraph, 1)
If NextPara Is Nothing Then
Else
Set PPWords = NextPara.Words
NextEnd = NextPara.End
If PPWords.Count > 1 Then 'yes
NewDocRange.Start = NewDocRange.End
NewDocRange.InsertParagraphBefore
NewDocRange.FormattedText = NextPara.FormattedText
End If
End If
Next SrcDocTable
End If
End Sub