将所有文本框（包含在每个工作表中）复制到 word 文档

Question

我正在尝试将每个工作表内容（文本框和形状，无单元格内容）导出到 word 文档中。结果不是我所期望的。如果有2个工作表，每个工作表都有一个文本框，一个文本框将被复制两次，另一个根本不会被复制！

Private Sub Export()
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
On Error Resume Next
WordApp.Documents.Add
WordApp.Visible = True

For Each ws In ActiveWorkbook.Worksheets
    ws.Shapes.SelectAll
    Selection.Copy

WordApp.Selection.PasteSpecial DataType:=wdPasteShape
Application.CutCopyMode = False

Next ws

End Sub

我缺少的是：

在每个 ws 导出后插入一个分页符
了解为什么一个工作表中的文本框被复制了两次而另一个工作表中的另一个文本框根本没有被复制

Answer 1

1。添加分页符

如果您想在 Word 文件的末尾插入分页符，您可以 (1) select Word 内容部分的末尾和 (2) 像这样插入分页符：

WordApp.Selection.EndKey Unit:=wdStory
WordApp.Selection.InsertBreak

您的代码将如下所示：

Private Sub Export_v1()
    Dim WordApp As Word.Application
    Set WordApp = CreateObject("Word.Application")
    On Error Resume Next
    WordApp.Documents.Add
    WordApp.Visible = True
    
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        ws.Shapes.SelectAll
        Selection.Copy

        WordApp.Selection.PasteSpecial DataType:=wdPasteShape
        Application.CutCopyMode = False
        
        WordApp.Selection.EndKey Unit:=wdStory
        WordApp.Selection.InsertBreak
        
    Next ws

End Sub

2。避免粘贴相同的文本框

如果您运行上面的宏，您仍然会从第一个 sheet 中获得文本框两次。为什么？因为您使用的 Selection.Copy 取决于哪个 sheet 处于活动状态。

要确保正确的 sheet 处于活动状态，只需在 select 形状之前添加 ws.Activate，如下所示：

Private Sub Export_v2()
    Dim WordApp As Word.Application
    Set WordApp = CreateObject("Word.Application")
    On Error Resume Next
    WordApp.Documents.Add
    WordApp.Visible = True
    
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
        ws.Shapes.SelectAll
        Selection.Copy

        WordApp.Selection.PasteSpecial DataType:=wdPasteShape
        Application.CutCopyMode = False
        
        WordApp.Selection.EndKey Unit:=wdStory
        WordApp.Selection.InsertBreak
        
    Next ws

End Sub

3. 潜在改进

3.1 避免在Excel

中使用Select

Avoiding using Select in Excel VBA 可以显着提高速度。但是，在这种情况下，您不能只替换

ws.Shapes.SelectAll
Selection.Copy

与

ws.Shapes.Copy

因为它不会复制形状。相反，您需要遍历作品中的每个形状 sheet 以将它们一一粘贴。这可能会给您的代码带来更多复杂性，因此如果速度不是问题，您可以保持这样。

3.2 将对象重置为空

为避免Excel 运行内存不足，最好在使用完对象后（在本例中是在过程结束时）将对象重置为空:

Set WordApp = Nothing

将所有文本框（包含在每个工作表中）复制到 word 文档

Copy all textboxes (contained in each worksheet) to a word document

excel

vba

export

ms-word

1。添加分页符

2。避免粘贴相同的文本框

3. 潜在改进