Hi Folks
I have a word document which is opened by an excel Macro. The excel macro calls on a macro in the word document and re saves the word document. The fields in the word document are linked and updated from another excel document.
The word macro I have looks at all the tables deletes empty rows and then empty tables. it then breaks the links to external the excel document using "ActiveDocument.Fields.Unlink"
I have two problems with the macro I cant resolve and I have searched high and low on the web for answers.
Firstly when I run the "ActiveDocument.Fields.Unlink" it breaks all links in the document. not just the links to the external excel document. So I lose the links in the "Number of Pages" on the cover page and also all of the links in documents Table of contents. Is there a way to Unlink only the links to the Excel document. the excel document will always be in the same place and have the same name.
Second problem I have is after my empty tables are cleared I am sometimes left with blank pages. I would also Like to find a way to delete the blank pages. I did manage to find one example of this on the web but it threw up an error on the first line of code.
Below is a copy of the Macro. Thanks in advance for any help.
Sub Clear_Tables_Unlink()
With ActiveDocument.Tables(8)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With
'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(8)
If .Rows.Count < 2 Then .Delete
End With
With ActiveDocument.Tables(7)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With
'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(7)
If .Rows.Count < 2 Then .Delete
End With
With ActiveDocument.Tables(6)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With
'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(6)
If .Rows.Count < 2 Then .Delete
End With
With ActiveDocument.Tables(5)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With
'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(5)
If .Rows.Count < 2 Then .Delete
End With
With ActiveDocument.Tables(4)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With
'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(4)
If .Rows.Count < 2 Then .Delete
End With
With ActiveDocument.Tables(3)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With
'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(3)
If .Rows.Count < 2 Then .Delete
End With
With ActiveDocument.Tables(2)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With
'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(2)
If .Rows.Count < 2 Then .Delete
End With
With ActiveDocument.Tables(1)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With
'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(1)
If .Rows.Count < 2 Then .Delete
End With
'**********This is the Section I have the problem with***********************
ActiveDocument.Fields.Unlink
'*********I would like something here to delete any remaining blank pages*********
ActiveDocument.SaveAs2 , _
FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
End Sub