2009-01-20 160 views
5

我想知道如何避免使用Windows剪贴板,当你想“复制”一个Word文档(中宏使用VBA)的多个部分复制Word文档的内容,而不使用剪贴板(VBA)

为什么要避免?因为我们在服务器上使用Word,所以在多用户环境下(我知道它被官方皱起了眉头)

否则,使用Selection.Copy和Selection.Paste方法很容易实现。

谢谢。

+0

很好,但让我们清楚,它不会“完全不支持”它的完全不支持,并会迟早会导致您的组件失败...可能当你不希望它。 – 2010-08-24 00:15:36

+0

我同意:) 是的,它会导致我们很多问题。但你知道它是怎么回事 - 我们多年前坚持下去 - 现在仍然需要支持它 - 当然我们今后不会采用同样的方法 – 2010-08-25 17:04:02

回答

3

我终于决心逐字复制。 FormattedText似乎工作得很好,直到最后一个字(某些特殊的(明显)字符),突然间,我刚刚填满复制内容的单元格将变为空白。当我增加了单元格的数量时,会弹出其他运行时错误,例如表格被损坏,以及其他模糊的错误。不知何故,我用来复制的源单元格总是似乎有ASCII码13和7的这些特殊字符。我知道13是什么意思,但是7? 无论如何,我决定从代码7的最后一个字符中复制所有内容。它似乎工作正常。格式化和字段也都被复制。无论如何,整个故事再次向我证明,VBA中的编程主要是试错性职业。你永远不知道什么时候会发生什么事情,除非我错过了一些关键概念的更新..

这是我使用的代码块。我们的想法是,首先我们有一个带有一个1x1单元格表格的文档,以及一些丰富的文本内容。在第一块码(一个宏内)的我乘以细胞:

(请注意,我在每个撇号型VB注释的前面放//使得评论将被正确地着色)

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

就是这样。

-1

使用选择对象的Text属性来把数据放到一个字符串变量,而不是到剪贴板:

暗淡strTemp作为字符串

strTemp = Selection.Text

然后,您可以根据需要在别处插入存储在变量中的文本。

+1

呵呵?其他的东西,如ole图像,字段代码等呢?否则罚款,如果你想要的只是文字 – 2010-08-24 00:18:07

1

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

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

整个文档复制到新文档中使用此:

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

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

  1. 打开源文件,并把一个书签覆盖我想要的范围(在我的情况下单个表)。
  2. 将源文档及其书签保存在另一个位置(以避免更改源文档)。
  3. 打开目标文档并为我放置表格的位置创建一个范围对象。
  4. 使用range.InsertFile与源文件的第一个参数与我的书签和我的书签名称的第二个参数。该单一操作将整个表格和源格式直接拖到目标文档中。

然后,我根据插入的完成位置以及故事选择插入的表的多长时间添加代码,以允许对其进行进一步的操作。

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

1

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

一个警告,我试图导出为.docx时出错,但RTF似乎工作正常。

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