Question

当你想“复制”Word文档的多个部分（在宏中使用VBA）时，我想知道如何避免使用Windows剪贴板

为什么要避免？因为我们在服务器上使用Word，在多用户环境中（我知道它是正式的不受欢迎）

否则，使用Selection.Copy和Selection.Paste方法很容易实现这一点。

感谢。

Answer 1

我终于决定一字一句地复制。 FormattedText似乎工作得相当好，直到最后一个字（一些特殊的（显然）字符），突然我刚刚填充复制内容的单元格将变为空白。当我增加单元格数量时，会弹出其他运行时错误，例如你的表被破坏，以及其他模糊的错误。不知何故，我复制的源单元似乎总是有这些特殊的字符，最后用ASCII码13和7.我知道13的意思是什么，但7？无论如何，我决定用代码7复制除最后一个字符之外的所有内容。它似乎工作正常。格式和字段也都被复制了。无论如何，整个故事再次向我证明了VBA中的编程主要是反复试验。你永远不确定什么时候可能会破坏......除非我错过了一些关键概念的更新。

这是我使用的代码块。我们的想法是，首先我们有一个带有单个1x1单元格表的文档，其中包含一些富文本内容。在代码的第一部分（宏内部）中，我将单元格相乘：

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文档的图像。第一个图像在运行宏之前，第二个图像在第一个代码块和最后一个代码之间，而第三个图像是生成的文档。

Image 1 Image 2 Image 3

就是这样。

Answer 2

这并不总是有效，例如文本字段，图表，或者如果您需要将其复制到另一个文档，但它可以在一个文档中复制简单的格式化文本。

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

要将整个文档复制到新文档，请使用以下命令：

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

Answer 3

我遇到了类似的问题。我想使用Powershell将表格从一个单词doc复制到另一个单词doc而不使用剪贴板。由于在脚本运行时使用计算机的用户可能会使用剪贴板破坏脚本。我想出的解决方案是：

打开源文档并放置一个书签，覆盖我想要的范围（在我的情况下是单个表格）。
将源文档及其书签保存在其他位置（以避免更改源文档）。
打开目标文档，并为我希望放置表格的位置创建了一个范围对象。
将range.InsertFile与源文件的第一个参数与我的书签和我的书签名称的第二个参数一起使用。此单个操作将整个表格和源格式直接拉入目标文档。

然后，我根据插入的位置添加了代码，以及选择插入表以允许进一步操作的故事的长度。

我尝试了许多其他方法来移动表格，这是迄今为止最好的方法。抱歉，我无法为此解决方案提供VBA代码。

Answer 4

在Office 2007+ VSTO中，您可以使用jsFiddle example导出该块，然后转到新文档并使用Range.ExportFragment导入该文档。我没有在生产中使用过这个，但是对它进行了实验，似乎工作正常。

有一点需要注意，我在尝试导出为.docx时出错，但RTF似乎工作正常。

这两种方法也存在于VBA中，但我只测试了VSTO方法。

Answer 5

使用Selection对象的Text属性将数据放入字符串变量而不是放在剪贴板上：

将strimmp作为字符串Dim

strTemp = Selection.Text

然后，您可以根据需要将存储在变量中的文本插入其他位置。

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

5 个答案: