Question

我的代码结果有问题：主要的想法是我有一个单词模板，我从excel文件中复制粘贴不同的表。表格分为12个不同的表格，分别名为表1，表2等。当这些表格中有一些数据时，代码完美无缺。这是整个代码：

Sub CreateBasicWordReport()
'Create word doc automatically
Dim wApp As Word.Application
Dim SaveName As String

Set wApp = New Word.Application

With wApp

'Make word visible

.Visible = True
.Activate
.Documents.Add "C:\Users\MyDesktop\TemplateWordFile.dotx"

'paste supplier name in word
Sheets("Sheet1").Range("C1").Copy
.Selection.Goto what:=wdGoToBookmark, name:="SupplierName"
.Selection.PasteSpecial DataType:=wdPasteText

'Dynamic range

Dim Table1 As Worksheet
Dim Table2 As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Set Table1 = Worksheets("Table 1")
Set Table2 = Worksheets("Table 2")
Set StartCell = Range("A1")

'Paste table 1 in word

Worksheets("Table 1").UsedRange
LastRow = Table1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Table1.Range("A1:J" & LastRow).Copy
.Selection.GoTo what:=wdGoToBookmark, name:="Table1"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdAlignRowLeft, DisplayAsIcon:=True

'Paste table 2 in word

Worksheets("Table 2").UsedRange
LastRow = Worksheets("Table 2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Worksheets("Table 2").Range("A1:J" & LastRow).Copy
.Selection.GoTo what:=wdGoToBookmark, name:="Table2"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdAlignRowLeft, DisplayAsIcon:=True

'Save doc to a specific location and with a specific title

Dim name As String
name = "C:\Users\MyDesktop\Supplier\" & "DocName" & "_" & _
Sheets("Sheet1").Range("C1").Value & "_" & Sheets("Sheet1").Range("H1").Value & _
"_" & Format(Now, "yyyy-mm-dd") & ".docx"

.ActiveDocument.SaveAs2 Filename:=name
End With
End Sub

问题是当纸张为空白时。我可能只需要一个表（来自表1）和IF下一个表（表2）是空的，然后我希望VBA什么也不做，然后转到下一步。但是在我的代码行中我得到运行时错误91：

 LastRow = Worksheets("Table 2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

我已尝试过“on next resume next”命令，如下所示：

'Paste table 2 in word

Worksheets("Table 2").UsedRange
On Error Resume Next
LastRow = Worksheets("Table 2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Worksheets("Table 2").Range("A1:J" & LastRow).Copy
.Selection.GoTo what:=wdGoToBookmark, name:="Table2"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdAlignRowLeft, DisplayAsIcon:=True

但在这种情况下，它会给我的word文件带来一个空表（五行，10行没有任何内容，只是表格的轮廓），而我只是希望它是空白的/什么都没有出现在我的word文件。

有人知道如何解决这个问题吗？

Answer 1

您可以将If Not IsEmpty(Table1.UsedRange) Then语句添加到代码中。如果工作表完全为空，这将阻止代码运行。如果您需要更多帮助，请发表评论。

Sub CreateBasicWordReport()
'Create word doc automatically
Dim wApp As Word.Application
Dim SaveName As String

Set wApp = New Word.Application

With wApp

'Make word visible

.Visible = True
.Activate
.Documents.Add "C:\Users\MyDesktop\TemplateWordFile.dotx"

'paste supplier name in word
Sheets("Sheet1").Range("C1").Copy
.Selection.Goto what:=wdGoToBookmark, name:="SupplierName"
.Selection.PasteSpecial DataType:=wdPasteText

'Dynamic range

Dim Table1 As Worksheet
Dim Table2 As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Set Table1 = Worksheets("Table 1")
Set Table2 = Worksheets("Table 2")
Set StartCell = Range("A1")

'Paste table 1 in word

If Not IsEmpty(Table1.UsedRange) Then
  LastRow = Table1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  Table1.Range("A1:J" & LastRow).Copy
  .Selection.GoTo what:=wdGoToBookmark, name:="Table1"
  .Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
  Placement:=wdAlignRowLeft, DisplayAsIcon:=True
End If

'Paste table 2 in word

If Not IsEmpty(Table2.UsedRange) Then
  LastRow = Worksheets("Table 2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  Table2.Range("A1:J" & LastRow).Copy
  .Selection.GoTo what:=wdGoToBookmark, name:="Table2"
  .Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
  Placement:=wdAlignRowLeft, DisplayAsIcon:=True
End If

'Save doc to a specific location and with a specific title

Dim name As String
name = "C:\Users\MyDesktop\Supplier\" & "DocName" & "_" & _
Sheets("Sheet1").Range("C1").Value & "_" & Sheets("Sheet1").Range("H1").Value & _
"_" & Format(Now, "yyyy-mm-dd") & ".docx"

.ActiveDocument.SaveAs2 Filename:=name
End With
End Sub

Answer 2

不幸的是我无法对Fabian的答案发表评论，但他的建议可能会解决你的问题。我只是认为你应该知道你的代码正在做什么 on on On Error Resume Next“转到下一行，无论是否有错误。因此，为了告诉程序在出现错误时执行不同的操作，您必须验证错误是否发生并处理它。

Answer 3

通过将表cpying / pasting委托给特定的子目录，可以避免一些代码重复并扩大代码应用程序：

Sub PasteTables(docContent As Word.Range, numTables As Long)
    Dim iTable As Long
    Dim myRng As Range

    With docContent
        For iTable = 1 To numTables
            Set myRng = Worksheets("Table " & iTable).UsedRange
            If Not IsEmpty(myRng) Then
                myRng.Copy
                .Goto(what:=wdGoToBookmark, name:="Table" & iTable).PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
                Placement:=wdAlignRowLeft, DisplayAsIcon:=True
                Application.CutCopyMode = False
            End If
        Next iTable
    End With
End Sub

相应地，您的主要代码会缩短为：

Option Explicit

Sub CreateBasicWordReport()
    'Create word doc automatically
    Dim wApp As Word.Application
    Dim name As String

    Set wApp = New Word.Application

    sheets("Sheet01").Range("C1").Copy
    With wApp.Documents.Add("C:\Users\MyDesktop\TemplateWordFile.dotx") '<-- open word document and reference it        
        'Make word visible
        .Parent.Visible = True
        .Parent.Activate

        'paste supplier name in word
        .content.Goto(what:=wdGoToBookmark, name:="SupplierName").PasteSpecial DataType:=wdPasteText
        Application.CutCopyMode = False '<-- it's always a good habit to set it after pasting has taken place

        'paste tables
        PasteTables .content, 2 '<-- call your specific Sub passing the referenced document content and "2" as the maximum number of tables to loop through

        'Save doc to a specific location and with a specific title
        name = "C:\Users\MyDesktop\Supplier\" & "DocName" & "_" & _
        sheets("Sheet1").Range("C1").Value & "_" & sheets("Sheet1").Range("H1").Value & _
        "_" & Format(Now, "yyyy-mm-dd") & ".docx"
        .ActiveDocument.SaveAs2 Filename:=name
    End With
End Sub

如何使我的VBA代码不执行任何操作并转到下一步/ VBA运行时错误91

3 个答案: