我想知道如何避免使用 Windows 剪贴板,当您想“复制”Word 文档的多个部分时(在宏中使用 VBA)
为什么要避免?因为我们在服务器上使用 Word,在多用户环境中(我知道它是官方不赞成的)
否则,这可以通过 Selection.Copy 和 Selection.Paste 方法轻松完成。
谢谢。
最佳答案
我终于决定逐字复制。 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
就是这样。
关于vba - 不使用剪贴板复制 Word 文档内容 (VBA),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/461840/