копирование содержимого документа Word без использования буфера обмена (VBA)

Я, наконец, решил скопировать слово в слово. FormattedText, казалось, работал довольно хорошо, до последнего слова (некоторые специальные (очевидно) символы), где внезапно ячейка, которую я только что заполнил скопированным контентом, станет пустой. Когда я увеличивал количество ячеек, появлялись другие ошибки во время выполнения, например, ваша таблица была повреждена, и другие неоднозначные. Так или иначе, исходная ячейка, из которой я копировал, всегда, казалось, имела эти своеобразные символы в конце с кодами ASCII 13 и 7. Я знаю что значит 13, но 7? В любом случае, я решил скопировать все, кроме этого последнего символа с кодом 7. Кажется, это работает нормально. Форматирование и поля копируются. В любом случае, вся эта история еще раз доказала мне, что программирование в VBA-это в основном занятие методом проб и ошибок. Никогда не знаешь, когда что-то может сломаться.. если только я не пропустил обновление некоторых важных концепций..

вот фрагменты кода, который я использовал. Идея в том, что сначала у нас есть документ с одна таблица ячеек 1x1 с некоторым содержимым rich text. В первом фрагменте кода (внутри макроса) я умножаю ячейки:

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 <= 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 <= max_cells And cur_width + origin_width < 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 < 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 <= max_cells Then
            ActiveDocument.Tables(1).Rows.Add
            cur_row = cur_row + 1
          End If

      Wend
   End If

во второй части макроса я заполняю каждую пустую ячейку содержимым первой ячейки:

   ' 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 <= 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) & 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 <> ActiveDocument.Tables(1).Rows(1).Cells(1).Range.Words.Count Then
                            rn.FormattedText = w
                        Else
                            'MsgBox "The strange text is: " & 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

вот изображения документа Word, о котором идет речь. Первое изображение перед запуском макроса, второе-между первым куском кода и последним, в то время как третье изображение является результатом документ.

Фото 1 Рисунок 2 Рисунок 3

вот именно.