复制Word文档的内容,而不使用剪贴板(VBA)
我想知道如何避免使用Windows剪贴板,当你想“复制”一个Word文档(中宏使用VBA)的多个部分复制Word文档的内容,而不使用剪贴板(VBA)
为什么要避免?因为我们在服务器上使用Word,所以在多用户环境下(我知道它被官方皱起了眉头)
否则,使用Selection.Copy和Selection.Paste方法很容易实现。
谢谢。
我终于决心逐字复制。 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文档的图像。第一个图像是运行宏之前,第二个是在第一个代码块和最后一个之间,而第三个图像是生成的文档。
就是这样。
使用选择对象的Text属性来把数据放到一个字符串变量,而不是到剪贴板:
暗淡strTemp作为字符串
strTemp = Selection.Text
然后,您可以根据需要在别处插入存储在变量中的文本。
呵呵?其他的东西,如ole图像,字段代码等呢?否则罚款,如果你想要的只是文字 – 2010-08-24 00:18:07
这并不总是有效,例如,使用文本字段,图表,或者如果您需要将其复制到另一个文档,但它适用于在一个文档中复制简单格式的文本。
'First select something, then do
Word.WordBasic.CopyText
'Then move somewhere
Word.WordBasic.OK;
整个文档复制到新文档中使用此:
Word.Application.Documents.Add Word.ActiveDocument.FullName
我遇到了类似的问题。我想在不使用剪贴板的情况下使用Powershell将表格从一个文档复制到另一个文档。由于在脚本运行时使用计算机的用户可能会使用剪贴板来破坏脚本。我想出的解决方案是:
- 打开源文件,并把一个书签覆盖我想要的范围(在我的情况下单个表)。
- 将源文档及其书签保存在另一个位置(以避免更改源文档)。
- 打开目标文档并为我放置表格的位置创建一个范围对象。
- 使用
range.InsertFile
与源文件的第一个参数与我的书签和我的书签名称的第二个参数。该单一操作将整个表格和源格式直接拖到目标文档中。
然后,我根据插入的完成位置以及故事选择插入的表的多长时间添加代码,以允许对其进行进一步的操作。
我尝试了许多其他方法来移动表,这是迄今为止最好的。抱歉,我无法为此解决方案提供VBA代码。
在Office 2007+ VSTO中,您可以使用Range.ExportFragment导出该块,然后转到新文档并使用Range.ImportFragment导入。我没有在生产中使用过这个,但是对它进行了实验,似乎工作正常。
一个警告,我试图导出为.docx时出错,但RTF似乎工作正常。
这两种方法都存在于VBA中,但我只测试了VSTO方法。
很好,但让我们清楚,它不会“完全不支持”它的完全不支持,并会迟早会导致您的组件失败...可能当你不希望它。 – 2010-08-24 00:15:36
我同意:) 是的,它会导致我们很多问题。但你知道它是怎么回事 - 我们多年前坚持下去 - 现在仍然需要支持它 - 当然我们今后不会采用同样的方法 – 2010-08-25 17:04:02