Consulting

Results 1 to 6 of 6

Thread: Help Break links to external document and not table of contents

  1. #1
    VBAX Newbie
    Joined
    Aug 2014
    Posts
    3
    Location

    Help Break links to external document and not table of contents

    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

  2. #2
    The code could be much simpler. The following addresses the link fields, but the blank pages are another issue.

    There are no 'pages' in a Word document, so in order to delete pages that display as blank, it is helpful to know why they are blank and what they contain.

    Sub Clear_Tables_Unlink()
    Dim lngTable As Long
    Dim R As Long
    Dim C As Cell
    Dim fnd As Boolean
    Dim fld As Field
    Dim oStory As Range
    
        For lngTable = 8 To 1 Step -1
            With ActiveDocument.Tables(lngTable)
                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(lngTable)
                If .Rows.Count < 2 Then .Delete
            End With
        Next lngTable
    
        '**********This is the Section I have the problem with***********************
    
        For Each oStory In ActiveDocument.StoryRanges
            For Each fld In oStory.Fields
                If fld.Type = wdFieldLink Then
                    fld.Unlink
                End If
            Next fld
            If oStory.StoryType <> wdMainTextStory Then
                While Not (oStory.NextStoryRange Is Nothing)
                    Set oStory = oStory.NextStoryRange
                    For Each fld In oStory.Fields
                        If fld.Type = wdFieldLink Then
                            fld.Unlink
                        End If
                    Next fld
                Wend
            End If
        Next oStory
    
        '*********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:=Val(Application.Version)
    
        Set oStory = Nothing
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Newbie
    Joined
    Aug 2014
    Posts
    3
    Location
    Graham thanks very much for your speedy reply.

    I just tested the breaking links to excel and it works perfectly My TOC links are still intact. Thank you!! Will get on to testing your simplified code next.

    I have two instances where I want to delete the blank pages the first instance only has the table in it once the macro deletes the table(s) where there is no data the page that the table was in remains. in this instance it will always be the last page/pages that are blank.

    The second instance there is a header a footer in the page, again this is the page(s) that are left after the table(s) have been deleted. This will not be the last page in the document.

    There will also be page breaks on each page.

    In the macro where it looks at each table to see if it is less than two rows, and the deletes the table if it is less than two rows, I want to also delete the page that the table was on.

    Thanks again for your help

    Tris
    Last edited by Tris1979; 08-22-2014 at 07:12 AM.

  4. #4
    So what you are saying is that each table is on a new page and because there are page breaks when a table is deleted the page is left empty and you want to remove that?
    Are the breaks manual page breaks or section breaks?
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Newbie
    Joined
    Aug 2014
    Posts
    3
    Location
    Yes that's exactly it. I would say they are manual. I put them in using, Insert > Page Break.

    Your simplified code is working perfectly as well thanks, a lot tidier now.

  6. #6
    Sorry, I got side-tracked and didn't get back to your question about removing the pages.
    Perhaps the simplest approach is to replace

    With ActiveDocument.Tables(lngTable) 
        If .Rows.Count < 2 Then .Delete 
    End With
    with

    With ActiveDocument.Tables(lngTable)
       If .Rows.Count < 2 Then
           .Select
           ActiveDocument.Bookmarks("\page").Range.Delete
       End If
    End With
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •