首页 文章

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

提问于
浏览 次
1

我的代码结果有问题：主要的想法是我有一个单词模板，我从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 error 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行没有任何内容，只是表格的轮廓），而我只是想让它为空白/我的单词文件中没有任何内容 .

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

excel vba excel-vba error-handling

3 回答

  • 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
    回复于
  • 0

    不幸的是我回答了，但他的建议可能会解决你的问题 . 我只是觉得你应该知道你的代码正在做什么 on "On Error Resume Next" is go to the next line, no matter if there is an error or not . 因此，为了告诉程序在出现错误时执行不同的操作，您必须验证错误是否发生并处理它 .

    回复于
  • 2

    你可以通过将表cpying / pasting委托给特定的sub来避免一些代码重复并扩展你的代码应用程序：

    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
    回复于

相关问题