不使用剪貼板（VBA）復制Word文檔內容

Question

我想知道如何避免使用Windows剪貼板，當你想“復制”Word文檔的多個部分時（在宏中使用VBA）

為什么要避免？ 因為我們在服務器上使用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文檔的圖像。 第一個圖像在運行宏之前，第二個圖像在第一個代碼塊和最后一個之間，而第三個圖像是結果文檔。

圖像1 圖像2 圖像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而不使用剪貼板。 由於在腳本運行時使用計算機的用戶可能會使用剪貼板破壞腳本。 我想出的解決方案是：

1. 打開源文檔並放置一個書簽，覆蓋我想要的范圍（在我的例子中是單個表）。
2. 將源文檔及其書簽保存在其他位置（以避免更改源文檔）。
3. 打開目標文檔並為我希望放置表格的位置創建了一個范圍對象。
4. 使用range.InsertFile ，帶有我的書簽的源文件的第一個參數和我的書簽名稱的第二個參數。 此單個操作將整個表格和源格式直接拉入目標文檔。

然后，我根據插入的位置添加代碼，以及選擇插入表以允許對其進行進一步操作的故事。

我嘗試了許多其他方法來移動表格，這是迄今為止最好的方法。 抱歉，我無法為此解決方案提供VBA代碼。

Answer 4

在Office 2007+ VSTO中，您可以使用Range.ExportFragment導出塊，然后轉到新文檔並使用Range.ImportFragment導入它。 我沒有在生產中使用過這個，但是對它進行了實驗，似乎工作正常。

有一點需要注意，我在嘗試導出為.docx時出錯，但RTF似乎工作正常。

這兩種方法也存在於VBA中，但我只測試了VSTO方法。

Answer 5

使用Selection對象的Text屬性將數據放入字符串變量而不是放在剪貼板上：

將strTemp作為字符串調暗

strTemp = Selection.Text

然后，您可以根據需要將存儲在變量中的文本插入其他位置。