[已解决]代码报错，请老师们给个解答，修改些代码。谢谢！

1261181315a

代码报错，请老师们给个解答，修改些代码。谢谢！

最佳答案

月排行榜 / 总排行榜

wp8680

2016-3-28 20:23

Sub f()
    Dim arr, i%
    Dim xlapp, adoc, X
    arr = Range("A1").CurrentRegion
    Set xlapp = CreateObject("word.application")   ' 打开w程序
    xlapp.Visible = True
    For i = 2 To UBound(arr)
        Set adoc = xlapp.Documents.Open(ThisWorkbook.Path & "\信息.doc")
        With adoc
            With .tables(1)
                .Cell(1, 2).Range = arr(i, 1)
                .Cell(1, 4).Range = arr(i, 2)
                .Cell(1, 6).Range = arr(i, 4)
                .Cell(2, 2).Range = arr(i, 3)
                .Cell(2, 4).Range = arr(i, 10)
                .Cell(2, 6).Range = arr(i, 8)
                .Cell(3, 2).Range = arr(i, 7)
                .Cell(3, 4).Range = arr(i, 6)
                .Cell(3, 6).Range = arr(i, 5)
                .Cell(4, 2).Range = arr(i, 11)
                .Cell(4, 4).Range = arr(i, 12)
                .Cell(5, 2).Range = arr(i, 9)
            End With
            .Save
            .SaveAs Filename:=ThisWorkbook.Path & "\" & arr(i, 1) & ".doc"
            .Close True
        End With
    Next
    Set adoc = Nothing
    xlapp.Quit
    Set xlapp = Nothing
End Sub

跳转到最佳答案楼层

爱疯

我这里试了，没报错。
另外，你那里的引用，勾了么，如图

wp8680

Sub f()
    Dim arr, i%
    Dim xlapp, adoc, X
    arr = Range("A1").CurrentRegion
    Set xlapp = CreateObject("word.application")   ' 打开w程序
    xlapp.Visible = True
    For i = 2 To UBound(arr)
        Set adoc = xlapp.Documents.Open(ThisWorkbook.Path & "\信息.doc")
        With adoc
            With .tables(1)
                .Cell(1, 2).Range = arr(i, 1)
                .Cell(1, 4).Range = arr(i, 2)
                .Cell(1, 6).Range = arr(i, 4)
                .Cell(2, 2).Range = arr(i, 3)
                .Cell(2, 4).Range = arr(i, 10)
                .Cell(2, 6).Range = arr(i, 8)
                .Cell(3, 2).Range = arr(i, 7)
                .Cell(3, 4).Range = arr(i, 6)
                .Cell(3, 6).Range = arr(i, 5)
                .Cell(4, 2).Range = arr(i, 11)
                .Cell(4, 4).Range = arr(i, 12)
                .Cell(5, 2).Range = arr(i, 9)
            End With
            .Save
            .SaveAs Filename:=ThisWorkbook.Path & "\" & arr(i, 1) & ".doc"
            .Close True
        End With
    Next
    Set adoc = Nothing
    xlapp.Quit
    Set xlapp = Nothing
End Sub

wp8680

跟我一样写，规规矩矩的，一定不会报错。