CODEWITHSUNDEEP
vbaexcelms-word
maddie
maddie

Reputation: 103

How to add rows to a merged Word table?

This is how the table looks like.

enter image description here

Code:

Sub WordTableTester()
Dim CurrentTable As table
Dim wdDoc As Document
Dim Rw As Long, col As Long
Dim wdFileName

wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , "Please choose a file containing requirements to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
    Set CurrentTable = wdDoc.Tables(1)
    Rw = 9: col = CurrentTable.Columns.Count
    wdDoc.Range(CurrentTable.Cell(Rw, 1).Range.start, _
    CurrentTable.Cell(Rw, col).Range.start).Select
    wdDoc.Application.Selection.InsertRowsBelow
End With


End Sub

When I run this, I get the an error message: Run-Time error '5941': The requested member of the collection does not exist.

Note: I'm running a VBA Excel Macro and importing/adding rows to a table in a Word Doc

Upvotes: 2

Views: 2679

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149287

Working with merged rows in MS Word Table is slightly tricky.

Is this what you want?

Sub Sample()
    Dim CurrentTable As Table
    Dim wdDoc As Document
    Dim Rw As Long, col As Long

    Set wdDoc = ActiveDocument '<~~ Created this for testing
    Set CurrentTable = wdDoc.Tables(1)

    Rw = 9: col = CurrentTable.Columns.Count

    wdDoc.Range(CurrentTable.Cell(Rw, 1).Range.Start, _
    CurrentTable.Cell(Rw, col).Range.Start).Select

    wdDoc.Application.Selection.InsertRowsBelow
End Sub

ScreenShot enter image description here

Edit

You table's format is all screwed up. Table was created with few rows and then the cells were merged/split to create new rows and hence you were getting the error. Also since you are automating word from excel, I would recommend the following way.

Try this

Sub WordTableTester()
    Dim oWordApp As Object, oWordDoc As Object, CurrentTable As Object
    Dim flName As Variant
    Dim Rw As Long, col As Long

    flName = Application.GetOpenFilename("Word files (*.docx),*.docx", _
    , "Please choose a file containing requirements to be imported")

    If flName = False Then Exit Sub

    Set oWordApp = CreateObject("Word.Application")
    oWordApp.Visible = True

    Set oWordDoc = oWordApp.Documents.Open(flName)
    Set CurrentTable = oWordDoc.Tables(1)

    Rw = 7: col = CurrentTable.Columns.Count

    oWordDoc.Range(CurrentTable.Cell(Rw, 1).Range.Start, _
    CurrentTable.Cell(Rw, col).Range.Start).Select

    oWordDoc.Application.Selection.InsertRowsBelow
End Sub

Upvotes: 3

Related Questions