不使用剪贴板（VBA）复制Word文档内容

Question

I was wondering how to avoid using Windows clipboard, when you want to "replicate" multiple sections of a Word document (using VBA in macros)

Why to avoid? Because we're using Word on a server, in a multiuser environment (I know that it is officially frowned upon)

Otherwise, this would be easily accomplished with Selection.Copy and Selection.Paste methods.

Thanks.

Answer 1

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..

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:

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

In the second part of the macro I populate each empty cell with the contents of the first cell:

   ' 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

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.

Image 1 Image 2 Image 3

That's it.

Answer 2

This doesn't always work, with text fields, diagramms, for example, or if you need to copy it to another document, but it's good for copying simple formatted text inside one document.

'First select something, then do
Word.WordBasic.CopyText
'Then move somewhere
Word.WordBasic.OK;

To copy the whole document to a new document use this:

Word.Application.Documents.Add Word.ActiveDocument.FullName

Answer 3

I ran into a similar issue. I wanted to copy a table from one word doc to another using Powershell without using the clipboard. Since a user using the computer while the script ran could break the script by using the clipboard. The solution I came up with was:

1. Open the source document and put a bookmark covering the range of what I wanted (in my case a single table).
2. Save the source document with its bookmark in another location (to avoid changing the source document).
3. Opened the destination document and created a range object for where I wanted the table placed.
4. Used range.InsertFile with the first parameter of the source file with my bookmark and the second parameter of my bookmark name. This single operation pulled the entire table plus source formatting directly into the destination document.

I then added code based on where the insertion was being done and how much longer the story was to select the inserted table to allow further operations on it.

I tried many any other methods to move the table and this was by far the best. Sorry I can't provide VBA code for this solution.

Answer 4

In Office 2007+ VSTO, you can export the block with Range.ExportFragment and then go to your new document and import it with Range.ImportFragment . I haven't used this in production, but experimented with it and it seems to work OK.

One caveat, I got errors when trying to export as a .docx, but RTF seemed to work ok.

Both methods exist in VBA as well, but I only tested the VSTO methods.

Answer 5

Use the Text property of the Selection object to put the data into a string variable rather than onto the clipboard:

Dim strTemp as String

strTemp = Selection.Text

You can then insert the text stored in the variable elsewhere as needed.