Processing Word Table cell content and retaining source formatting-CodePudding

Searches have failed to provide an answer to this question. I have two Word tables (different numbers of rows and columns), lets call them "source" and "dest". The source table cell contents are formatted text, and I wish to take the content of each "source" table cell, process the content, and then store the content in a cell of the table in the destination doc. My vba is in Excel (as I need that for other parts of the processing).

The Word table cell contents are generally several sentences of text and the processing I wish to do varies: straight copy, separate into individual lines (vbCr), concatenate short lines, remove some unwanted characters etc. Source formatting is generally bolding, highlighting and use of superscripts.

My initial approach takes each source cell content to a string variable using e.g.

strContent = wordDoc.Tables(iCurrTab).Cell(iCurrRow, iCurrCell).Range.FormattedText

Inspection at this point reveals the source formatting has already been lost.

Question: How do I get the cell content with its formatting into a string I can process?

I have reviewed Copy Text from Table in Word and Retaing Formatting (but require to do more than just copy and paste a cell range).

Thank you for the comments and reminder. (In some other languages, strings are just “bytes”!). The comments may provide the solution, but for the future benefit of all, I’ve decided to post more detail.

My cell content example (Latin) would be anything between 5 and 30 lines similar to:

Ad hanc Curiam venit Ric[ard]us Roberts unus Ten[en]tium Custumar[iorum] hujus Manerii et in plena Curia s[e]c[un]d[u]m modum sursumredd[idit] in manus D[omi]nor[um] unum Claus[um] terra[e] Custumar[iae] vocat[um] ‘Smallewood’ et unu[m] a[lium] Claus[um] terra[e] Custumar[iae] vocat[um] ‘Marsh Close’ cum pertinen[tia] jacen[tia] et…….

The text has line endings (vbCr) inserted so the text layout matches the original handwritten document line by line. The [] are in pairs and indicate where the original contracted Latin has been expanded to its full form. (In the real text I use chevrons not [], but can’t post those here…). The single quotes are insertions used to identify local place names. Formatting in the original includes bold, highlighting and superscripts.

I wish to produce several different outputs based on a user selected operating mode for the macro. Each output will go into a single cell in a table (in the output Word document). The different outputs are:

A copy of the entire content of each cell. Formatting retained.
A line-by-line copy (based on vbCr delimiter) placing each line in a separate cell in the output table. Formatting retained.
As 1 but with the [] removed. Formatting retained.
As 1 but with the “[] pairs” and the text between the [] pairs removed (that makes it a copy of of the original Latin script). Bold formatting retained.
A list of the place names by identifying the locations contained within single quotes.

All existing code is string based using instr, replace etc and I’ve implemented all 5 alternatives but without retaining formatting (as per comment). What I’m now seeking, is to replace that initial simplistic approach with solutions that retain the bold, highlighting etc formatting (so no point in posting existing code). The thread mentioned earlier is a solution for 1 so the requirement becomes finding a simple technique for doing the required editing either “in flight” or within the destination cell.

Hope that clarifies.

CodePudding user response：

For example:

Sub TblDemo()
'Note: A reference to the Word library must be set, via Tools|References
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim wdTblSrc As Word.Table, wdTblTgt As Word.Table, wdRng As Word.Range
Dim StrFnd As String, i As Long
With wdApp
  .Visible = False
  Set wdDoc = .Documents.Open(FileName:="Full Path & Name", ReadOnly:=False, AddToRecentFiles:=False)
  With wdDoc
    Set wdTblSrc = .Tables(1)
    Set wdTblTgt = .Tables(2)
    With wdTblSrc.Range
      For i = 1 To .Cells.Count
        Set wdRng = .Cells(i).Range
        wdRng.End = wdRng.End - 1
        wdTblTgt.Range.Cells(i).Range.FormattedText = wdRng.FormattedText
      Next
    End With
    i = InputBox("Required Ouput Format:" & vbCr & _
                  "1. Original" & vbCr & _
                  "2. Original minus chevrons" & vbCr & _
                  "3. Original minus chevrons and intervening text" & vbCr & _
                  "4. Place Names")
    Select Case i
      Case 2: StrFnd = "[\{\}]"
      Case 3: StrFnd = "\{[!\{]@\}"
      Case 4: StrFnd = "‘[!‘]@’"
    End Select
    Select Case i
      Case 2, 3
        With wdTblTgt.Range.Find
          .Format = False
          .Forward = True
          .Wrap = wdFindStop
          .MatchWildcards = True
          .Text = StrFnd
          .Replacement.Text = ""
          .Execute Replace:=wdReplaceAll
        End With
      Case 4
        With wdTblTgt.Range
          .Font.Hidden = True
          With .Find
            .Format = True
            .Forward = True
            .Wrap = wdFindStop
            .MatchWildcards = True
            .Text = StrFnd
            .Font.Hidden = True
            .Replacement.Font.Hidden = False
            .Replacement.Text = "^&"
            .Execute Replace:=wdReplaceAll
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = ""
            .Replacement.Text = ""
            .Format = False
            .Font.Hidden = True
            .Execute Replace:=wdReplaceAll
          End With
          .Font.Hidden = False
        End With
    End Select
  End With
  .Visible = True
End With
Set wdRng = Nothing: Set wdTblSrc = Nothing: Set wdTblTgt = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

Since you haven't told us anything meaningful about the table structures, you'll need to adapt the above to suit.