Editing Word Document Created from Excel

[*shudder*]

Hello All,

I have a macro which creates a Word document and applies some editing. I am now trying to search for a specific word in the document and deleting the line the text appears in.

I have found the following code which works in Word VBA, however using it in Excel does nothing.

Sub del_txt_row()

Dim oRng As Word.Range
Dim oRngDelete As Word.Range

Set oRng = ActiveDocument.Range

With oRng.find
    .Text = "Not Applicable"
    While .Execute
        oRng.Select
        Set oRngDelete = ActiveDocument.Bookmarks("\Line").Range
        oRngDelete.delete
    Wend
End With

End Sub

How can I adapt this or is there an alternative method?

Thanks in advance.

 

[RoryA]

You need to post the macro that creates the document too so that we can determine how to integrate that code into it. You can't simply refer to activedocument like that from Excel - it needs to either be qualified with a Word.Application object or replaced with a reference to the document your other code created.

 

[*shudder*]

That might help Rory!

This is the code to populate the template the user has selected from the file dialogue box:

Sub insertIntoWordBookmark()
     ' define error handler
    On Error GoTo ErrorHandler
     '
     ' resltValues is a collection of the names from the ResultTables
     ' worksheet
    Dim resultValues As Collection
    Set resultValues = New Collection
     ' resultValues is an excel name object as a member of the resultValues collection
    Dim resultValue As Excel.Name
     '
     ' declare and set the variable nms a the active workbooks
     ' names collection. The workbooks names collection contains
     ' all the workbook's named cell rangesthese will be used to
     ' insert the target word document.
    Dim nms As Excel.Names
    Set nms = ActiveWorkbook.Names
    
     '
     ' loop incrementer
    Dim i As Integer
    
     '
     ' create the word target document, the document is set later it the script
    Dim targetWord As Word.Document
     '
     ' loop through excel named ranges and set the name of the bookmarks that
     ' will be updated are only from the worksheet named Result Tables
    For i = 1 To nms.Count
         'copy range value
         '    If nms(i).RefersToRange.Parent.Name = "ResultTables" Then
        resultValues.Add Item:=nms(i), Key:=nms(i).Name
         '    End If
    Next i
     '
     '
     ' create and set the word application object
    Dim appWord As Word.Application
    Set appWord = New Word.Application
     ' open word doc
    Dim pathToWord As String
    pathToWord = tName

    If fileExists(pathToWord) = True Then Set targetWord = appWord.Documents.Add(pathToWord)
    '
     ' loop through the word document and create a temporary collection
     ' of the documents original bookmarks, the script will delete any
     ' new bookmarks that are introduce by the insertion process.
    Dim oBookmarks As Collection
    Dim oBookmark As Word.Bookmark
    Dim delete As Boolean
     '
    Set oBookmarks = New Collection
    For Each oBookmark In targetWord.Bookmarks
        oBookmarks.Add Item:=oBookmark, Key:=oBookmark.Name
    Next oBookmark
     '
     ' loop through our results and paste into word
    For Each resultValue In resultValues
        If targetWord.Bookmarks.Exists(resultValue.Name) Then
             ' determine if the source area in Excel is a single cell range, or a
             ' multiple cell range.
            If resultValue.RefersToRange.Count > 1 Then
                ' we have a table
                insertTable targetWord, resultValue
            ElseIf resultValue.RefersToRange.Count = 1 Then
                ' we have a value
                insertValue targetWord, resultValue
            End If
        End If
    Next resultValue

    'Copy charts to bookmarks
    InsertChart targetWord

    'Stop cut/copy
    Application.CutCopyMode = False
   
    'Update table of contents
    With targetWord
        .TablesOfContents(1).Update
        .TablesOfContents(1).UpdatePageNumbers
    End With
    On Error GoTo ErrorHandler
     '
     ' clean up any introduced bookmarks
    Dim targetBookmark As Word.Bookmark
    For Each targetBookmark In targetWord.Bookmarks
        delete = True
        For Each oBookmark In oBookmarks
            If UCase(oBookmark.Name) = UCase(targetBookmark.Name) Then
                delete = False
                 ' found a match break out of loop
                Exit For
            End If
        Next oBookmark
         ' delete bad bookmark
        If delete Then
            targetBookmark.delete
        End If
    Next targetBookmark
    On Error GoTo 0
     '
     ' activate word document
    With appWord
       
        'Convert all auto-numbering to text only
        If ActiveDocument.Lists.Count > 0 Then
            Dim lisAutoNumList As List
           
            For Each lisAutoNumList In ActiveDocument.Lists
                lisAutoNumList.ConvertNumbersToText
            Next
        End If
   
        .Visible = True
        .ActiveWindow.WindowState = 0
        .ActiveWindow.Caption = fName
        .Activate
        End If
    End With
   
ErrorExit:
    Set resultValues = Nothing
    Set nms = Nothing
    Set appWord = Nothing
    Set targetWord = Nothing
    Set oBookmarks = Nothing
    Exit Sub
    
'Error Handling routine
ErrorHandler:
    If eRR Then
        MsgBox "Failed"
        If Not appWord Is Nothing Then
            appWord.Quit False
        End If
        Resume ErrorExit
    End If
End Sub

 

[RoryA]

You've got a couple of unqualified references in that second bit of code that may cause you problems, so I've fixed those and added in the other code below (marked the section I added with '##### for clarity):

Sub insertIntoWordBookmark()
     ' define error handler
    On Error GoTo ErrorHandler
     '
     ' resltValues is a collection of the names from the ResultTables
     ' worksheet
    Dim resultValues As Collection
    Set resultValues = New Collection
     ' resultValues is an excel name object as a member of the resultValues collection
    Dim resultValue As Excel.Name
     '
     ' declare and set the variable nms a the active workbooks
     ' names collection. The workbooks names collection contains
     ' all the workbook's named cell rangesthese will be used to
     ' insert the target word document.
    Dim nms As Excel.Names
    Set nms = ActiveWorkbook.Names
    
     '
     ' loop incrementer
    Dim i As Integer
    
     '
     ' create the word target document, the document is set later it the script
    Dim targetWord As Word.Document
     '
     ' loop through excel named ranges and set the name of the bookmarks that
     ' will be updated are only from the worksheet named Result Tables
    For i = 1 To nms.Count
         'copy range value
         '    If nms(i).RefersToRange.Parent.Name = "ResultTables" Then
        resultValues.Add Item:=nms(i), Key:=nms(i).Name
         '    End If
    Next i
     '
     '
     ' create and set the word application object
    Dim appWord As Word.Application
    Set appWord = New Word.Application
     ' open word doc
    Dim pathToWord As String
    pathToWord = tName

    If fileExists(pathToWord) = True Then Set targetWord = appWord.Documents.Add(pathToWord)
    '
     ' loop through the word document and create a temporary collection
     ' of the documents original bookmarks, the script will delete any
     ' new bookmarks that are introduce by the insertion process.
    Dim oBookmarks As Collection
    Dim oBookmark As Word.Bookmark
    Dim delete As Boolean
     '
    Set oBookmarks = New Collection
    For Each oBookmark In targetWord.Bookmarks
        oBookmarks.Add Item:=oBookmark, Key:=oBookmark.Name
    Next oBookmark
     '
     ' loop through our results and paste into word
    For Each resultValue In resultValues
        If targetWord.Bookmarks.Exists(resultValue.Name) Then
             ' determine if the source area in Excel is a single cell range, or a
             ' multiple cell range.
            If resultValue.RefersToRange.Count > 1 Then
                ' we have a table
                insertTable targetWord, resultValue
            ElseIf resultValue.RefersToRange.Count = 1 Then
                ' we have a value
                insertValue targetWord, resultValue
            End If
        End If
    Next resultValue

    'Copy charts to bookmarks
    InsertChart targetWord

    'Stop cut/copy
    Application.CutCopyMode = False
   
    'Update table of contents
    With targetWord
        .TablesOfContents(1).Update
        .TablesOfContents(1).UpdatePageNumbers
    End With
    On Error GoTo ErrorHandler
     '
     ' clean up any introduced bookmarks
    Dim targetBookmark As Word.Bookmark
    For Each targetBookmark In targetWord.Bookmarks
        delete = True
        For Each oBookmark In oBookmarks
            If UCase(oBookmark.Name) = UCase(targetBookmark.Name) Then
                delete = False
                 ' found a match break out of loop
                Exit For
            End If
        Next oBookmark
         ' delete bad bookmark
        If delete Then
            targetBookmark.delete
        End If
    Next targetBookmark
    On Error GoTo 0
     '
       
        'Convert all auto-numbering to text only
        If targetWord.Lists.Count > 0 Then
            Dim lisAutoNumList As List
           
            For Each lisAutoNumList In targetWord.Lists
                lisAutoNumList.ConvertNumbersToText
            Next
        End If
        
   '################################################################
   Dim oRng As Word.Range
   Dim oRngDelete As Word.Range
   
   Set oRng = targetWord.Range
   
   With oRng.Find
       .Text = "Not Applicable"
       While .Execute
           oRng.Select
           Set oRngDelete = targetWord.Bookmarks("\Line").Range
           oRngDelete.delete
       Wend
   End With
   
   '################################################################
   
    With appWord
     ' activate word document
        .Visible = True
        .ActiveWindow.WindowState = 0
        .ActiveWindow.Caption = fName
        .Activate
        End If
    End With
   
   
ErrorExit:
    Set resultValues = Nothing
    Set nms = Nothing
    Set appWord = Nothing
    Set targetWord = Nothing
    Set oBookmarks = Nothing
    Exit Sub
    
'Error Handling routine
ErrorHandler:
    If Err Then
        MsgBox "Failed"
        If Not appWord Is Nothing Then
            appWord.Quit False
        End If
        Resume ErrorExit
    End If
End Sub

 

[*shudder*]

You've got a couple of unqualified references in that second bit of code that may cause you problems, so I've fixed those and added in the other code below (marked the section I added with '##### for clarity):

Great, thanks Rory

 

[RoryA]

Glad we could help.