none
Word Table Horizontal Merge Cells Problem RRS feed

  • Question

  • I am trying to merge cells horizontally and It does not work, i need another set of eyes to look at what I am doing wrong. This is very urgent any help will be appreciated.

      Dim licWithTable As SdtBlock = mainPart.Document.Body.Descendants(Of SdtBlock)().Where(Function(r) r.SdtProperties.GetFirstChild(Of Tag)().Val = "LicenseListing").[Single]()
                        Dim licTable As Table = licWithTable.Descendants(Of Table)().[Single]()
                        Dim theFirstLicRow As TableRow = licTable.Elements(Of TableRow)().First()
                        ' Find the third cell in the row.
                        Dim cell As TableCell = theFirstLicRow.Elements(Of TableCell)().ElementAt(2)
                        ' Find the first paragraph in the table cell.
                        Dim p As Paragraph = cell.Elements(Of Paragraph)().First()
                        p.Append(GetValue(reportType, rLargeBoldPr))
                        Dim theLicRow As TableRow = licTable.Elements(Of TableRow)().Last()
                        For Each licColl As LicenseData In licenseColl
                            Dim rowCopy As TableRow = DirectCast(theLicRow.CloneNode(True), TableRow)
                            rowCopy.Descendants(Of TableCell)().ElementAt(0).Append(New Paragraph(GetValue(licColl.lien.ToString, rSmallNormalPr)))
                            rowCopy.Descendants(Of TableCell)().ElementAt(1).Append(New Paragraph(GetValue(licColl.classType.ToString, rSmallNormalPr)))
                            rowCopy.Descendants(Of TableCell)().ElementAt(2).Append(New Paragraph(GetValue(licColl.status.ToString, rSmallNormalPr)))
                            rowCopy.Descendants(Of TableCell)().ElementAt(3).Append(New Paragraph(GetValue(licColl.permit.ToString, rSmallNormalPr)))
                            rowCopy.Descendants(Of TableCell)().ElementAt(4).Append(New Paragraph(GetValue(licColl.issueDate.ToString, rSmallNormalPr)))
                            rowCopy.Descendants(Of TableCell)().ElementAt(5).Append(New Paragraph(GetValue(licColl.expDate.ToString, rSmallNormalPr)))
                            'rowCopy.Descendants(Of TableCell)().ElementAt(6).Append(New Paragraph(GetValue(licColl.Restrictions.ToString, rSmallNormalPr)))
                            rowCopy.Descendants(Of TableCell)().ElementAt(6).Append(New Paragraph(GetValue(licColl.Enforcements.ToString, rSmallNormalPr)))
                            licTable.AppendChild(rowCopy)
                            'Add Row for Restrictions If Any
                            If Len(Trim(licColl.Restrictions.ToString)) > 0 Then
                                Dim restArr As String() = licColl.Restrictions.ToString.Split("~")
                                For Each restStr In restArr
                                    If Len(Trim(restStr)) > 0 Then
                                        Dim rowR As TableRow = DirectCast(theLicRow.CloneNode(True), TableRow)
                                        'merge all cells
                                        Dim tableCellProperties As New TableCellProperties()
                                        Dim horizontalMerge As New HorizontalMerge() With { _
                                         .Val = MergedCellValues.Restart _
                                        }
                                        Dim tableCellProperties1 As New TableCellProperties()
                                        Dim horizontalMerge1 As New HorizontalMerge() With { _
                                         .Val = MergedCellValues.[Continue] _
                                        }
                                        tableCellProperties1.Append(horizontalMerge1)
                                        'Dim tableCellProperties2 As New TableCellProperties()
                                        'Dim horizontalMerge2 As New HorizontalMerge() With { _
                                        ' .Val = MergedCellValues.[Continue] _
                                        '}
                                        'tableCellProperties2.Append(horizontalMerge2)
                                        rowR.Descendants(Of TableCell)().ElementAt(0).Append(tableCellProperties)
                                        rowR.Descendants(Of TableCell)().ElementAt(1).Append(tableCellProperties1)
                                        'rowR.Descendants(Of TableCell)().ElementAt(2).Append(tableCellProperties2)
                                        'rowR.Descendants(Of TableCell)().ElementAt(3).Append(tableCellProperties3)
                                        'rowR.Descendants(Of TableCell)().ElementAt(4).Append(GetHorizontalMergeContinue)
                                        'rowR.Descendants(Of TableCell)().ElementAt(5).Append(GetHorizontalMergeContinue)
                                        'rowR.Descendants(Of TableCell)().ElementAt(6).Append(GetHorizontalMergeContinue)
                                        'Add Text
                                        rowR.Descendants(Of TableCell)().ElementAt(0).Append(New Paragraph(GetValue(restStr, rSmallNormalPr)))
                                        licTable.AppendChild(rowR)
                                    End If
                                Next
                            End If
                        Next
                        ' Remove the empty placeholder row from the table.
                        licTable.RemoveChild(theLicRow)

    Thursday, February 28, 2013 10:04 PM

Answers

  • <w:tc xmlns:w="http://schemas.openxmlformats.org/wordprocessingml/2006/main">
      <w:tcPr>
        <w:tcW w:w="6384" w:type="dxa" />
        <w:gridSpan w:val="2" />
      </w:tcPr>
      <w:p w:rsidR="00A10F86" w:rsidRDefault="00A10F86">
        <w:bookmarkStart w:name="_GoBack" w:colFirst="0" w:colLast="0" w:id="0" />
      </w:p>
    </w:tc>
    Imports DocumentFormat.OpenXml.Packaging
    Imports DocumentFormat.OpenXml.Wordprocessing
    Imports System.Windows.Forms
    
    Module Module1
        Dim OpenFile As Func(Of String) = AddressOf OpenFileM
        Dim OWD As Action(Of String, Boolean) = _
            AddressOf OpenWordprecessingDocument
        Dim MT As Action(Of WordprocessingDocument) = AddressOf MergeTable
    
        Sub Main()
            Dim Path As String = OpenFile()
    
            OpenWordprecessingDocument(Path, True)
    
        End Sub
    
        Function OpenFileM() As String
            Dim OFD As OpenFileDialog = New OpenFileDialog()
            OFD.Filter = "Word Document|*.docx;*.docm;*.dotx;*.dotm"
            OFD.InitialDirectory = System.Environment.GetFolderPath( _
                Environment.SpecialFolder.Desktop)
            OFD.ShowDialog()
            Return OFD.FileName
        End Function
    
        Sub OpenWordprecessingDocument(ByVal Path As String, _
                                       ByVal Editable As Boolean)
            Using WPD As WordprocessingDocument = WordprocessingDocument.Open(Path, _
                Editable)
                MT(WPD)
            End Using
        End Sub
    
        Sub MergeTable(ByVal WPD As WordprocessingDocument)
            Dim MP As MainDocumentPart
            Dim B As Body
            Dim T As Table
            Dim R As TableRow
            Dim C1 As TableCell
            Dim C2 As TableCell
            Dim P1 As Paragraph
            Dim GS As GridSpan = New GridSpan
    
            MP = WPD.MainDocumentPart
            B = MP.Document.Body
            T = B.Descendants(Of Table)().FirstOrDefault()
            R = T.Descendants(Of TableRow)().FirstOrDefault()
            C1 = R.Descendants(Of TableCell)().ToList()(0)
            C2 = R.Descendants(Of TableCell)().ToList()(1)
            For Each P1 In C2.Descendants(Of Paragraph)()
                C1.Append(P1.Clone())
            Next
            C2.Remove()
            GS.Val = 2
            C1.TableCellProperties.Append(GS)
            MP.Document.Save()
        End Sub
    
    End Module

    Have a good day,

    Tom


    Monday, March 4, 2013 2:55 AM
    Moderator

All replies

  • Hi shauhan,

    I can't found the GridSpan in your program. Please confirm whether you forgot it.

    Have a good day,

    Tom

    Friday, March 1, 2013 1:14 AM
    Moderator
  • i didnt forget it, how to and where to add gridspan? please help.
    Friday, March 1, 2013 2:07 PM
  • <w:tc xmlns:w="http://schemas.openxmlformats.org/wordprocessingml/2006/main">
      <w:tcPr>
        <w:tcW w:w="6384" w:type="dxa" />
        <w:gridSpan w:val="2" />
      </w:tcPr>
      <w:p w:rsidR="00A10F86" w:rsidRDefault="00A10F86">
        <w:bookmarkStart w:name="_GoBack" w:colFirst="0" w:colLast="0" w:id="0" />
      </w:p>
    </w:tc>
    Imports DocumentFormat.OpenXml.Packaging
    Imports DocumentFormat.OpenXml.Wordprocessing
    Imports System.Windows.Forms
    
    Module Module1
        Dim OpenFile As Func(Of String) = AddressOf OpenFileM
        Dim OWD As Action(Of String, Boolean) = _
            AddressOf OpenWordprecessingDocument
        Dim MT As Action(Of WordprocessingDocument) = AddressOf MergeTable
    
        Sub Main()
            Dim Path As String = OpenFile()
    
            OpenWordprecessingDocument(Path, True)
    
        End Sub
    
        Function OpenFileM() As String
            Dim OFD As OpenFileDialog = New OpenFileDialog()
            OFD.Filter = "Word Document|*.docx;*.docm;*.dotx;*.dotm"
            OFD.InitialDirectory = System.Environment.GetFolderPath( _
                Environment.SpecialFolder.Desktop)
            OFD.ShowDialog()
            Return OFD.FileName
        End Function
    
        Sub OpenWordprecessingDocument(ByVal Path As String, _
                                       ByVal Editable As Boolean)
            Using WPD As WordprocessingDocument = WordprocessingDocument.Open(Path, _
                Editable)
                MT(WPD)
            End Using
        End Sub
    
        Sub MergeTable(ByVal WPD As WordprocessingDocument)
            Dim MP As MainDocumentPart
            Dim B As Body
            Dim T As Table
            Dim R As TableRow
            Dim C1 As TableCell
            Dim C2 As TableCell
            Dim P1 As Paragraph
            Dim GS As GridSpan = New GridSpan
    
            MP = WPD.MainDocumentPart
            B = MP.Document.Body
            T = B.Descendants(Of Table)().FirstOrDefault()
            R = T.Descendants(Of TableRow)().FirstOrDefault()
            C1 = R.Descendants(Of TableCell)().ToList()(0)
            C2 = R.Descendants(Of TableCell)().ToList()(1)
            For Each P1 In C2.Descendants(Of Paragraph)()
                C1.Append(P1.Clone())
            Next
            C2.Remove()
            GS.Val = 2
            C1.TableCellProperties.Append(GS)
            MP.Document.Save()
        End Sub
    
    End Module

    Have a good day,

    Tom


    Monday, March 4, 2013 2:55 AM
    Moderator