Function replace_tables() ' convert simple tables (no merged cells!) Dim oRow As Row Dim oCell As Cell Dim sCellText As String Dim tTable As Table Dim noRows, noCells As Long 'StatusBar = "Convert tables..." For Each tTable In ActiveDocument.Tables For Each oRow In tTable.Rows For Each oCell In oRow.Cells sCellText = oCell.Range sCellText = Left$(sCellText, Len(sCellText) - 2) If Len(sCellText) = 0 Then sCellText = " " sCellText = "<td>" & sCellText & "</td>" oCell.Range = sCellText Next oCell sCellText = oRow.Cells(1).Range sCellText = Left$(sCellText, Len(sCellText) - 2) sCellText = "<tr>" & vbCr & sCellText oRow.Cells(1).Range = sCellText sCellText = oRow.Cells(oRow.Cells.Count).Range sCellText = Left$(sCellText, Len(sCellText) - 2) sCellText = sCellText & vbCr & "</tr>" oRow.Cells(oRow.Cells.Count).Range = sCellText Next oRow sCellText = tTable.Rows(1).Cells(1).Range sCellText = Left$(sCellText, Len(sCellText) - 2) sCellText = "<table>" & vbCr & sCellText tTable.Rows(1).Cells(1).Range = sCellText noRows = tTable.Rows.Count noCells = tTable.Rows(noRows).Cells.Count sCellText = tTable.Rows(noRows).Cells(noCells).Range sCellText = Left$(sCellText, Len(sCellText) - 2) sCellText = sCellText & vbCr & "</table>" tTable.Rows(noRows).Cells(noCells).Range = sCellText tTable.ConvertToText Separator:=wdSeparateByParagraphs Next tTable End Function
var
This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)