将所有文本框包含在每个工作表中复制到Word文档中 1添加分页符 2避免粘贴同一文本框 3.潜在的改进

问题描述

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

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导出后插入@R_50_6404@
了解为什么工作表中的一个文本框被复制两次，而另一个工作表中的另一个文本框根本不被复制

解决方法

1。添加分页符

如果要在Word文件的末尾插入分页符，可以（1）选择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。避免粘贴同一文本框

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

要确保正确的工作表处于活动状态，只需在选择以下形状之前添加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中使用“选择”

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

ws.Shapes.SelectAll
Selection.Copy

使用

ws.Shapes.Copy

，因为它不会复制形状。取而代之的是，您需要遍历工作表中的每个形状，一次一个地粘贴它们。这可能会给您的代码带来更多的复杂性，因此，如果速度不是问题，则可以保持这种状态。

3.2将对象重置为空

为避免Excel内存不足，一种好习惯是在使用完对象后始终将对象重置为空（在本例中为过程的最后）：

Set WordApp = Nothing

excel excel export ms-word