Note that there are some explanatory texts on larger screens.

plurals
  1. PO
    primarykey
    data
    text
    <p>I finally resolved to copy word by word. FormattedText seemed to work fairly well, until the last word (some special (evidently) characters), where suddenly the cell that I just filled with copied content would go blank. When I increased the number of cells, other run-time errors would pop up, like Your table got corrupted, and other ambiguous ones. Somehow, the source cell that I was copying from always seemed to have these peculiar chars in the end with ASCII codes 13 and 7. I know what 13 means, but 7? Anyway, I decided to copy everything apart from this last character with code 7. It seems to work alright. Both formatting and fields are copied too. In any case, the whole story proved to me for one more time that programming in VBA is mostly trial-and-error occupation. You are never sure when something might break.. unless I am missing update on some crucial concepts..</p> <p>Here's the chunks of the code I used. The idea is that first we have a document with a single 1x1 cell table, with some rich text content. In the first piece of the code (inside a macro) I multiply the cells:</p> <pre><code>Dim cur_width As Integer, i As Integer, max_cells As Integer, cur_row As Integer Dim origin_width As Integer If ActiveDocument.Tables.Count = 1 _ And ActiveDocument.Tables(1).Rows.Count = 1 _ And ActiveDocument.Tables(1).Columns.Count = 1 _ Then max_cells = 7 ' how many times we are going to "clone" the original content i = 2 ' current cell count - starting from 2 since the cell with the original content is cell number 1 cur_width = -1 ' current width cur_row = 1 ' current row count origin_width = ActiveDocument.Tables(1).Rows(1).Cells(1).Width ' loop for each row While i &lt;= max_cells ' adjust current width If cur_row = 1 Then cur_width = origin_width Else cur_width = 0 End If ' loop for each cell - as long as we have space, add cells horizontally While i &lt;= max_cells And cur_width + origin_width &lt; ActiveDocument.PageSetup.PageWidth Dim col As Integer ' \ returns floor() of the result col = i \ ActiveDocument.Tables(1).Rows.Count // 'add cell, if it is not already created (which happens when we add rows) If ActiveDocument.Tables(1).Rows(cur_row).Cells.Count &lt; col Then ActiveDocument.Tables(1).Rows(cur_row).Cells.Add End If // 'adjust new cell width (probably unnecessary With ActiveDocument.Tables(1).Rows(cur_row).Cells(col) .Width = origin_width End With // 'keep track of the current width cur_width = cur_width + origin_width i = i + 1 Wend ' when we don't have any horizontal space left, add row If i &lt;= max_cells Then ActiveDocument.Tables(1).Rows.Add cur_row = cur_row + 1 End If Wend End If </code></pre> <p>In the second part of the macro I populate each empty cell with the contents of the first cell:</p> <pre><code> ' duplicate the contents of the first cell to other cells Dim r As Row Dim c As Cell Dim b As Boolean Dim w As Range Dim rn As Range b = False i = 1 For Each r In ActiveDocument.Tables(1).Rows For Each c In r.Cells If i &lt;= max_cells Then // ' don't copy first cell to itself If b = True Then ' copy everything word by word For Each w In ActiveDocument.Tables(1).Rows(1).Cells(1).Range.Words ' get the last bit of formatted text in the destination cell, as range ' do it first by getting the whole range of the cell, then collapsing it ' so that it is now the very end of the cell, and moving it one character ' before (because collapsing moves the range actually beyond the last character of the range) Set rn = c.Range rn.Collapse Direction:=wdCollapseEnd rn.MoveEnd Unit:=wdCharacter, Count:=-1 ' somehow the last word of the contents of the cell is always Chr(13) &amp; Chr(7) ' and especially Chr(7) causes some very strange and murky problems ' I end up avoiding them by not copying the last character, and by setting as a rule ' that the contents of the first cell should always contain an empty line in the end If c.Range.Words.Count &lt;&gt; ActiveDocument.Tables(1).Rows(1).Cells(1).Range.Words.Count Then rn.FormattedText = w Else 'MsgBox "The strange text is: " &amp; w.Text 'the two byte values of this text (which obviously contains special characters with special 'meaning to Word can be found (and watched) with 'AscB(Mid(w.Text, 1, 1)) and AscB(Mid(w.Text, 2, 1)) w.MoveEnd Unit:=WdUnits.wdCharacter, Count:=-1 rn.FormattedText = w End If Next w End If b = True End If i = i + 1 Next c Next r </code></pre> <p>Here are the images of the Word document in question. First image is before running the macro, second is between the first chunk of code and the last, while the third image is the resulting document.</p> <p><a href="http://i41.photobucket.com/albums/e276/morninghalo/stackovfl/1.jpg" rel="nofollow noreferrer">Image 1</a> <a href="http://i41.photobucket.com/albums/e276/morninghalo/stackovfl/2.jpg" rel="nofollow noreferrer">Image 2</a> <a href="http://i41.photobucket.com/albums/e276/morninghalo/stackovfl/done.jpg" rel="nofollow noreferrer">Image 3</a></p> <p>That's it.</p>
    singulars
    1. This table or related slice is empty.
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. VO
      singulars
      1. This table or related slice is empty.
    2. VO
      singulars
      1. This table or related slice is empty.
    3. VO
      singulars
      1. This table or related slice is empty.
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload